home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap11 / howto01 / delphi10 / cciccfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-12  |  167.2 KB  |  4,847 lines

  1. unit Cciccfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl, CCWSock, CCICCInf,
  8.   CCICCPrf, IniFiles, Gauges , CCUUCode;
  9.  
  10. type
  11.   { This record holds the information for a number of internet connections }
  12.   PConnectionsRecord = ^TConnectionsRecord;
  13.   TConnectionsRecord = record
  14.     CProfile   : String; { Connection profile; used in lists }
  15.     CIPAddress : String; { Dotted character IP Address       }
  16.     CUserName  : String; { Login name to site; can be anonym }
  17.     CPassword  : String; { Password; won't be shown          }
  18.     CStartDir  : String; { Starting directory; used for FTP  }
  19.   end;
  20.   { Array of TCR }
  21.   CRFile = file of TConnectionsRecord; { File type for TCRec }
  22.   { This record is used to hold information about a newsgroup            }
  23.   { NOTE : hi and low pointers indicate either dl or trashing without dl }
  24.   { "read" is for an article dl'd but not trashed.                       }
  25.   PNewsGroupRecord = ^TNewsGroupRecord;
  26.   TNewsGroupRecord = record
  27.     GName                : String;  { Profile of the newsgroup              }
  28.     GRealName            : String;  { Real Newsrc name of the newsgroup     }
  29.     GLowest              : Longint; { Number of lowest dl/trashed article   }
  30.     GHighest             : Longint; { Number of highest dl/trashed article  }
  31.     GTotalNew            : Longint; { Total New articles available          }
  32.     GTotalAvailable      : Longint; { After update, shows how many arts on s}
  33.     GLowestAvailable     : Longint; { au, shows lowest a# on server         }
  34.     GHighestAvailable    : Longint; { au, shows highest a# on server        }
  35.     GPostable            : Boolean; { Can post to newsgroup                 }
  36.     GSubscribed          : Boolean; { Subscribed to newsgroup               }
  37.     GTotalArticles       : Longint; { Total articles maintained on system   }
  38.     GTotalUnReadArticles : Longint; { Total unread articles on system       }
  39.     GIDNumber            : Integer;
  40.     GFileName            : String;  { Name of file holding articles records }
  41.     GLTag                : Longint; { Tag field to hold pointer to arts TL  }
  42.   end;
  43.   NGRFile = file of TNewsGroupRecord; { File type for NGRec }
  44.   { This record is used to hold information about Newsgroup articles }
  45.   PNewsGroupArticleRecord = ^TNewsGroupArticleRecord;
  46.   TNewsGroupArticleRecord = record
  47.     NGAGroupname   : String;  { Newsgroup name (redundancy safeguard)     }
  48.     NGASubject     : String;  { Subject of article                        }
  49.     NGANumber      : Longint; { Article number                            }
  50.     NGADownloaded  : boolean; { Article attempted/succeeded downloading   }
  51.     NGASender      : String;  { Article's putative sender (CIUPKC158=us)  }
  52.     NGARead        : Boolean; { Article read flag                         }
  53.     NGAPosted      : Boolean; { Article posted flag                       }
  54.     NGAArtFileName : String;  { Name of system-gen file with article text }
  55.   end;
  56.   NGARFile = file of TNewsGroupArticleRecord;
  57.   { This record is used to hold information about EMail Mailboxes }
  58.   PEMailMailBoxRecord = ^TEMailMailBoxRecord;
  59.   TEMailMailBoxRecord = record
  60.     MBName        : String;  { Name of the mailbox                     }
  61.     MBIDNumber    : Integer;
  62.     MBMaxMsgNumber : Longint;
  63.     MBTotal       : Longint; { Total Mail Messages in Mailbox          }
  64.     MBUnReadTotal : Longint; { Total unread Mail Messages in Mailbox   }
  65.     MBUnSentTotal : Longint; { Total unsent Mail Messages in Mailbox   }
  66.     MBMsgFileName : String;  { Name of file holding Messages records   }
  67.     MBLTag        : Longint; { Tag to pointer to Tlist holding msgrecs }
  68.   end;
  69.   EMMBRFile = file of TEMailMailBoxRecord; { File type for EMMBRec }
  70.   { This record is used to hold information about EMail messages in a Mailbox }
  71.   PEMailMessageRecord = ^TEMailMessageRecord;
  72.   TEMailMessageRecord = record
  73.     MRMailBoxName      : String;  { Name of mailbox (redundancy safeguard)       }
  74.     MRMessageSubject   : String;  { Subject of the Message                       }
  75.     MRMessageRecipient : String;  { EMail address of primary recipient           }
  76.     MRMessageSender    : String;  { EMail address of sender                      }
  77.     MRCarbonCopy       : String;  { EMail CC recips; "|" delimited               }
  78.     MRBlindCarbonCopy  : String;  { EMail BCC recips; "|" delimited              }
  79.     MRDateTime         : String;  { EMail date/time field                        }
  80.     MRRead             : Boolean; { EMail Read flag                              }
  81.     MRSent             : Boolean; { EMail Send flag                              }
  82.     MRFileName         : String;  { EMail system generated filename for msg text }
  83.   end;
  84.   EMMRFile = file of TEMailMessageRecord; { File type for EMMRec }
  85.   TCCINetCCForm = class(TForm)
  86.     MainMenu1: TMainMenu;
  87.     Network1: TMenuItem;
  88.     N1: TMenuItem;
  89.     Exit1: TMenuItem;
  90.     Services1: TMenuItem;
  91.     IPAddress1: TMenuItem;
  92.     EMail1: TMenuItem;
  93.     FTP1: TMenuItem;
  94.     UsenetNws1: TMenuItem;
  95.     Panel1: TPanel;
  96.     Panel2: TPanel;
  97.     Panel3: TPanel;
  98.     Panel4: TPanel;
  99.     Panel5: TPanel;
  100.     Panel6: TPanel;
  101.     ListBox1: TListBox;
  102.     Panel7: TPanel;
  103.     SpeedButton1: TSpeedButton;
  104.     SpeedButton2: TSpeedButton;
  105.     ListBox2: TListBox;
  106.     ComboBox1: TComboBox;
  107.     Button1: TButton;
  108.     Memo1: TMemo;
  109.     Files1: TMenuItem;
  110.     Edit1: TMenuItem;
  111.     Encoding1: TMenuItem;
  112.     EMail2: TMenuItem;
  113.     FTP2: TMenuItem;
  114.     News1: TMenuItem;
  115.     Load1: TMenuItem;
  116.     Save1: TMenuItem;
  117.     Cut1: TMenuItem;
  118.     Copy1: TMenuItem;
  119.     CopytoFile1: TMenuItem;
  120.     Paste1: TMenuItem;
  121.     PastefromFile1: TMenuItem;
  122.     UUDecode1: TMenuItem;
  123.     MIMEDecode1: TMenuItem;
  124.     UUEncode1: TMenuItem;
  125.     MIMEEncode1: TMenuItem;
  126.     CheckMail1: TMenuItem;
  127.     ReplyToCurrentMessage1: TMenuItem;
  128.     SendCurrentMessage1: TMenuItem;
  129.     SendQueue1: TMenuItem;
  130.     Mailboxes1: TMenuItem;
  131.     Correspondents1: TMenuItem;
  132.     EmptyTrash1: TMenuItem;
  133.     SpeedButton4: TSpeedButton;
  134.     SpeedButton5: TSpeedButton;
  135.     SpeedButton3: TSpeedButton;
  136.     Panel8: TPanel;
  137.     Label1: TLabel;
  138.     Label2: TLabel;
  139.     ComboBox2: TComboBox;
  140.     Label3: TLabel;
  141.     ComboBox3: TComboBox;
  142.     ConnectToSite1: TMenuItem;
  143.     Disconnect1: TMenuItem;
  144.     UploadMarked1: TMenuItem;
  145.     DownloadMarked1: TMenuItem;
  146.     Directory1: TMenuItem;
  147.     ASCII1: TMenuItem;
  148.     Binary1: TMenuItem;
  149.     ASCII2: TMenuItem;
  150.     Binary2: TMenuItem;
  151.     ViewRemoteasText1: TMenuItem;
  152.     FTPSites1: TMenuItem;
  153.     CheckNewNews1: TMenuItem;
  154.     GetMarked1: TMenuItem;
  155.     CreateNewMessage1: TMenuItem;
  156.     Article1: TMenuItem;
  157.     SubscribedNewsgroups1: TMenuItem;
  158.     Trash1: TMenuItem;
  159.     Preferences1: TMenuItem;
  160.     EMail3: TMenuItem;
  161.     FTP3: TMenuItem;
  162.     News2: TMenuItem;
  163.     Label4: TLabel;
  164.     Label5: TLabel;
  165.     ViewasText1: TMenuItem;
  166.     Change1: TMenuItem;
  167.     Create1: TMenuItem;
  168.     Delete3: TMenuItem;
  169.     ChangeLocal1: TMenuItem;
  170.     OpenDialog1: TOpenDialog;
  171.     SaveDialog1: TSaveDialog;
  172.     Paths1: TMenuItem;
  173.     ProgressInfo1: TMenuItem;
  174.     N2: TMenuItem;
  175.     ViewInEditWindow1: TMenuItem;
  176.     ViewInStatusLine1: TMenuItem;
  177.     SaveToFile1: TMenuItem;
  178.     ViewWinsockInfo1: TMenuItem;
  179.     Description1: TMenuItem;
  180.     SystemStatus1: TMenuItem;
  181.     VendorSpecific1: TMenuItem;
  182.     Gauge1: TGauge;
  183.     NewsServers1: TMenuItem;
  184.     AllReadArticles1: TMenuItem;
  185.     AllMarkedArticles1: TMenuItem;
  186.     AllAvailableArticles1: TMenuItem;
  187.     NewArticle1: TMenuItem;
  188.     FollowupArticle1: TMenuItem;
  189.     Post1: TMenuItem;
  190.     CurrentArticle1: TMenuItem;
  191.     EntireQueue1: TMenuItem;
  192.     ConnectandUpdate1: TMenuItem;
  193.     Disconnect2: TMenuItem;
  194.     Headers1: TMenuItem;
  195.     RetrieveMarked1: TMenuItem;
  196.     RetrieveAll1: TMenuItem;
  197.     DownloadActiveNewsgroups1: TMenuItem;
  198.     PutinQueue1: TMenuItem;
  199.     TrashMarkedMessages1: TMenuItem;
  200.     MailServers1: TMenuItem;
  201.     ExitEMailRequired1: TMenuItem;
  202.     ToCurrentMessage1: TMenuItem;
  203.     ToNewMessage1: TMenuItem;
  204.     ToFile2: TMenuItem;
  205.     AbortNewsgroupDownload1: TMenuItem;
  206.     Catchup1: TMenuItem;
  207.     Marked1: TMenuItem;
  208.     All1: TMenuItem;
  209.     File1: TMenuItem;
  210.     SelectedArticle1: TMenuItem;
  211.     SelectMultipleArticles1: TMenuItem;
  212.     DecodeSelections1: TMenuItem;
  213.     procedure Exit1Click(Sender: TObject);
  214.     procedure FormCreate(Sender: TObject);
  215.     procedure FormDestroy(Sender: TObject);
  216.     procedure Description1Click(Sender: TObject);
  217.     procedure SystemStatus1Click(Sender: TObject);
  218.     procedure VendorSpecific1Click(Sender: TObject);
  219.     procedure ViewInEditWindow1Click(Sender: TObject);
  220.     procedure ViewInStatusLine1Click(Sender: TObject);
  221.     procedure SaveToFile1Click(Sender: TObject);
  222.     procedure IPAddress1Click(Sender: TObject);
  223.     procedure FTP1Click(Sender: TObject);
  224.     procedure FormResize(Sender: TObject);
  225.     procedure FTPSites1Click(Sender: TObject);
  226.     procedure FTP3Click(Sender: TObject);
  227.     procedure ConnectToSite1Click(Sender: TObject);
  228.     procedure Button1Click(Sender: TObject);
  229.     procedure ViewasText1Click(Sender: TObject);
  230.     procedure Disconnect1Click(Sender: TObject);
  231.     procedure ToDisplay1Click(Sender: TObject);
  232.     procedure ToFile1Click(Sender: TObject);
  233.     procedure Binary2Click(Sender: TObject);
  234.     procedure Change1Click(Sender: TObject);
  235.     procedure ChangeLocal1Click(Sender: TObject);
  236.     procedure ListBox1DblClick(Sender: TObject);
  237.     procedure ListBox2DblClick(Sender: TObject);
  238.     procedure ASCII1Click(Sender: TObject);
  239.     procedure DeleteRemoteFiles1Click(Sender: TObject);
  240.     procedure Binary1Click(Sender: TObject);
  241.     procedure Delete3Click(Sender: TObject);
  242.     procedure Create1Click(Sender: TObject);
  243.     procedure ListBox1Click(Sender: TObject);
  244.     procedure UsenetNws1Click(Sender: TObject);
  245.     procedure Disconnect2Click(Sender: TObject);
  246.     procedure News2Click(Sender: TObject);
  247.     procedure ConnectandUpdate1Click(Sender: TObject);
  248.     procedure CheckNewNews1Click(Sender: TObject);
  249.     procedure NewsServers1Click(Sender: TObject);
  250.     procedure SubscribedNewsgroups1Click(Sender: TObject);
  251.     procedure RetrieveMarked1Click(Sender: TObject);
  252.     procedure RetrieveAll1Click(Sender: TObject);
  253.     procedure GetMarked1Click(Sender: TObject);
  254.     procedure NewArticle1Click(Sender: TObject);
  255.     procedure FollowupArticle1Click(Sender: TObject);
  256.     procedure PutinQueue1Click(Sender: TObject);
  257.     procedure CurrentArticle1Click(Sender: TObject);
  258.     procedure EntireQueue1Click(Sender: TObject);
  259.     procedure AllReadArticles1Click(Sender: TObject);
  260.     procedure AllMarkedArticles1Click(Sender: TObject);
  261.     procedure AllAvailableArticles1Click(Sender: TObject);
  262.     procedure DownloadActiveNewsgroups1Click(Sender: TObject);
  263.     procedure UUEncode1Click(Sender: TObject);
  264.     procedure Load1Click(Sender: TObject);
  265.     procedure Save1Click(Sender: TObject);
  266.     procedure EMail1Click(Sender: TObject);
  267.     procedure MailServers1Click(Sender: TObject);
  268.     procedure EMail3Click(Sender: TObject);
  269.     procedure Paths1Click(Sender: TObject);
  270.     procedure Cut1Click(Sender: TObject);
  271.     procedure Copy1Click(Sender: TObject);
  272.     procedure CopytoFile1Click(Sender: TObject);
  273.     procedure Paste1Click(Sender: TObject);
  274.     procedure PastefromFile1Click(Sender: TObject);
  275.     procedure SpeedButton5Click(Sender: TObject);
  276.     procedure SpeedButton1Click(Sender: TObject);
  277.     procedure SpeedButton2Click(Sender: TObject);
  278.     procedure ListBox2Click(Sender: TObject);
  279.     procedure AbortNewsgroupDownload1Click(Sender: TObject);
  280.     procedure Marked1Click(Sender: TObject);
  281.     procedure All1Click(Sender: TObject);
  282.     procedure File1Click(Sender: TObject);
  283.     procedure SelectedArticle1Click(Sender: TObject);
  284.     procedure SelectMultipleArticles1Click(Sender: TObject);
  285.     procedure DecodeSelections1Click(Sender: TObject);
  286.     procedure SpeedButton4Click(Sender: TObject);
  287.   private
  288.     { Private declarations }
  289.   public
  290.     { Public declarations }
  291.     procedure EnableFTPMenus;
  292.     procedure DisableFTPMenus;
  293.     procedure EnableNNTPMenus;
  294.     procedure DisableNNTPMenus;
  295.     procedure EnablePOP3SMTPMenus;
  296.     procedure DisablePOP3SMTPMenus;
  297.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  298.     procedure UpdateUUGauge( BytesFinished , TotalToHandle : longint );
  299.     function DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  300.     function DoNNTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  301.     procedure DoFTPDisconnect;
  302.     procedure DoNNTPDisconnect;
  303.     procedure ReadIniData;
  304.     procedure WriteIniData;
  305.     procedure LoadFTPSiteFile;
  306.     procedure LoadNNTPSiteFile;
  307.     procedure LoadEmailServerFile;
  308.     procedure SaveEMailServerFile;
  309.     procedure SetupEMailServerStatus;
  310.     procedure SetupNNTPServersInfoDisplay;
  311.     procedure SaveFTPSiteFile;
  312.     procedure SetupFTPSiteLists;
  313.     procedure SaveNNTPSiteFile;
  314.     procedure SetupNNTPSiteLists;
  315.     procedure SetupNNTPNewsGroupsInfoDisplay;
  316.     procedure SetupNNTPNewsGroupLists;
  317.     procedure SaveNNTPNewsGroupLists;
  318.     procedure SetupNewsGroupListboxes;
  319.     procedure SetupEMailServersInfoDisplay;
  320.     procedure PopulateLB2WithArticleHeaders;
  321.     procedure AddNullTermTextToMemo( TheTextToAdd   : String;
  322.                                      TheMemoToAddTo : TMemo   );
  323.     function AddNullTermTextToLabel( TheTextToAdd   : String ) : String;
  324.     procedure SetHGCursors;
  325.     procedure SetNormalCursors;
  326.     procedure AddProgressText( WhatText : String );
  327.     procedure ShowProgressText( WhatText : String );
  328.     procedure ShowProgressErrorText( WhatText : String );
  329.     procedure SocketsErrorOccurred( Sender     : TObject;
  330.                                      ErrorCode  : Integer;
  331.                                      TheMessage : String   );
  332.   end;
  333.   { Component to hold FTP handling capabilities }
  334.   TFTPComponent = class( TWinControl )
  335.   public
  336.     FTPCommandInProgress ,
  337.     Connection_Established : Boolean;
  338.     Socket1 : TCCSocket;
  339.     Socket2 : TCCSocket;
  340.     constructor Create( AOwner : TComponent ); override;
  341.     destructor Destroy; override;
  342.     function GetTotalBytesToReceive( TheString : String ) : Longint;
  343.     function StripBrackets( TheString : String ) : String;
  344.     function GetShortPathname( TheString : String ) : String;
  345.     function GetWin16FileName( InputName : String ) : String;
  346.     function GetRemoteWorkingDirectory( var RemoteDir : String ) : Boolean;
  347.     function SetRemoteDirectory( TheDir : String ) : Boolean;
  348.     function DeleteRemoteDirectory( TheDir : String ) : Boolean;
  349.     function CreateRemoteDirectory( TheDir : String ) : Boolean;
  350.     function DeleteRemoteFile( TheFileName : String ) : Boolean;
  351.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  352.     function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
  353.     function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
  354.     function SetRemoteStartupDirectory( PCRPointer : PConnectionsRecord )
  355.               : Boolean;
  356.     function GetRemoteDirectoryListing( TheListBox : TListBox ) : Boolean;
  357.     function GetRemoteDirectoryListingToMemo : Boolean;
  358.     procedure SendASCIILocalFile( LocalName : String );
  359.     procedure SendBinaryLocalFile( LocalName : String );
  360.     procedure ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
  361.     procedure ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
  362.     function GetLocalDirectoryAndListing( var TheString : String;
  363.                                               TheListBox : TListBox )
  364.               : Boolean;
  365.     function GetUNIXTextString( var StringIn : String ) : String;
  366.     procedure ReceiveASCIIRemoteFileToMemo( RemoteName : String );
  367.     function GetListeningPort : Integer;
  368.     procedure GetFileNameFromUNIXFileName( var TheName : String );
  369.     function Disconnect : Boolean;
  370.     function DoCStyleFormat(       TheText      : string;
  371.                              const TheArguments : array of const ) : String;
  372.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  373.     function GetQuotedString( TheString : String ) : String;
  374.     procedure AddProgressText( WhatText : String );
  375.     procedure ShowProgressText( WhatText : String );
  376.     procedure ShowProgressErrorText( WhatText : String );
  377.     function GetFTPServerResponse( var ResponseString : String ) : integer;
  378.     procedure FTPSocketsErrorOccurred( Sender     : TObject;
  379.                                      ErrorCode  : Integer;
  380.                                      TheMessage : String   );
  381.     function PerformFTPCommand(
  382.                     TheCommand   : string;
  383.               const TheArguments : array of const ) : Integer;
  384.   end;
  385. const
  386.   POV_MEMO                 = 1; { Progress to the Memo           }
  387.   POV_STAT                 = 2; { Progress to the status caption }
  388.   TCPIP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  389.   TCPIP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  390.   TCPIP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  391.   TCPIP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  392.   TCPIP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }
  393.  
  394. var
  395.   CCINetCCForm         : TCCINetCCForm;
  396.   GlobalErrorCode      : Integer;        { Used to pass around error info  }
  397.   GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }
  398.   ProgressList         : TStringList;    { Used to hold progress text info }
  399.   ProgressFileName     : String;         { Used to hold progress file name }
  400.   ProgressOutputVector : Integer;        { Used to direct progress output  }
  401.   TheFTPSiteList       : TList;          { Used to store the FTP site recs }
  402.   TheWorkingFTPSL      : TList;          { Used to store working copy of l }
  403.   TheNewsServerList    : TList;          { Used to hold list of NNTP servs }
  404.   TheWorkingNSSL       : TList;          { Used for working copy of above  }
  405.   TheEMailServerList   : TList;          { Used for list of POP3/SMTP serv }
  406.   TheWorkingEMSL       : TList;          { Used for working copy of above  }
  407.   TheNewsRCList        : TList;          { Used for list of available ngs  }
  408.   TheWorkingNRCSL      : TList;          { Used for working copy of above  }
  409.   TheNGArticlesList    : TList;          { Used for current articles list  }
  410.                                          { (will hot swap from pointer of  }
  411.                                          {  Tlist of Tlists in base rec.)  }
  412.   TheEMailServerFile   : CRFile;         { File of Email servers records   }
  413.   TheNewsServerFile    : CRFile;         { File of NNTP servers records    }
  414.   TheNewsRCFile        : NGRFile;        { File of Newsgroups records      }
  415.   TheNewsArticleFile   : NGARFile;       { Current ng articles records file}
  416.   TheEMailMailboxFile  : EMMBRFile;      { File of Mailboxes records       }
  417.   TheEMailMessagesFile : EMMRFile;       { Current mb messages records file}
  418.   TheFTPSiteFile       : CRFile;         { Used to load the FTP site file  }
  419.   TheICCIniFile        : TIniFile;       { Used to retrieve the INI File   }
  420.   MailPath             : String;         { Used for path to Mail Files     }
  421.   NewsPath             : String;         { Used for path to News Files     }
  422.   FTPPath              : String;         { Used for path to FTP Files      }
  423.   CurrentPassWordString : String;        { Used to hold login id for anons }
  424.   CurrentEMPassWordString : String;      { Used to hold login id for anons }
  425.   PassWordControlVector : Integer;       { Used to hold display of pw vect }
  426.   CurrentRealPWString   : String;        { Used to hold a real password    }
  427.   EMPassWordControlVector : Integer;       { Used to hold display of pw vect }
  428.   CurrentEMRealPWString   : String;        { Used to hold a real password    }
  429.   TheFTPComponent       : TFTPComponent; { FTP Object                      }
  430.   TheLine ,
  431.   HolderLine ,
  432.   GlobalTextBuffer      : String;
  433.   TheAnonRedialVector ,
  434.   DefaultDownloadVector : Integer;
  435.   NewsReadArticlePurgingVector : Integer;
  436.   NewsPostQueueingVector : Integer;
  437.   NewsReadArticleDisplayVector : Integer;
  438.   NewsUUMIMEVector : Integer;
  439.   NewsInitialUpdateVector : Integer;
  440.   LeftoverText          : String;
  441.   LeftoversOnTable      : Boolean;
  442.   FileNameToXFer        : String;
  443.   WhichServer           : Integer;       { Holds current NNTP server }
  444.   WhichGroup            : Integer;       { Holds current NNTP newsgroup }
  445.   TheUUObject           : TUUCodingObject;
  446.   EMRemoteDeletionVector : Integer;
  447.   EMChokeVector : Integer;
  448.   EMDefaultDownloadVector : Integer;
  449.   EMQueueVector : Integer;
  450.   NewsgroupListLoaded ,
  451.   EmailLoaded ,
  452.   NewMessageInProgress : Boolean;
  453.   TheUUDecodeList      : TStringList;
  454.   
  455. implementation
  456.  
  457. uses CCICNNTP;
  458.  
  459. var
  460.   TheNNTPComponent      : TNNTPComponent;{ NNTP News Object                }
  461.  
  462. {$R *.DFM}
  463.  
  464.  
  465.  
  466. { Procedure to load the POP3SMTP Site list }
  467. procedure TCCINetCCForm.LoadEmailServerFile;
  468. var ThePSSRecord : PConnectionsRecord; { Generic TCR Pointer    }
  469.     PSSLName     : String;             { POP3SMTP Site List filename }
  470.     Counter_1    : Integer;            { Loop counter           }
  471. begin
  472.   { Create the sites list list }
  473.   TheEMailServerList := TList.Create;
  474.   { Set up the FTP sites list file name }
  475.   PSSLName := MailPath + '\PSSERVER.TCR';
  476.   { If the FTP Site List exists load it in }
  477.   if FileExists( PSSLName ) then
  478.   begin
  479.     { set up the file and open it }
  480.     AssignFile( TheEMailServerFile , PSSLName );
  481.     Reset( TheEMailServerFile );
  482.     { read in the records }
  483.     for Counter_1 := 0 to FileSize( TheEMailServerFile ) - 1 do
  484.     begin
  485.       { Create the TCRecord }
  486.       New( ThePSSRecord );
  487.       { Read in the data record }
  488.       Seek( TheEMailServerFile , Counter_1 );
  489.       Read( TheEMailServerFile , ThePSSRecord^ );
  490.       { Add the record to the list }
  491.       TheEMailServerList.Add( ThePSSRecord );
  492.     end;
  493.     { close the file }
  494.     CloseFile( TheEMailServerFile );
  495.   end
  496.   else
  497.   { Otherwise create a default one with the a generic mail site (?) }
  498.   begin
  499.     { create new record }
  500.     New( ThePSSRecord );
  501.     { fill in its info }
  502.     with ThePSSRecord^ do
  503.     begin
  504.       CProfile   := 'My Mail Server';
  505.       CIPAddress := 'mail.myprovider.com';
  506.       CUserName  := 'myname';
  507.       CPassword  := 'mypassword';
  508.       CStartDir  := 'myname@myprovider.com';
  509.     end;
  510.     { add it to the list }
  511.     { do it three more times }
  512.     TheEMailServerList.Add( ThePSSRecord );
  513.     { create the file and write out the data, then close it }
  514.     AssignFile( TheEMailServerFile , PSSLName );
  515.     Rewrite( TheEMailServerFile );
  516.     ThePSSRecord :=
  517.        PConnectionsRecord( TheEMailServerList.Items[ 0 ] );
  518.       Seek( TheEMailServerFile , 0 );
  519.       Write( TheEMailServerFile , ThePSSRecord^ );
  520.     CloseFile( TheEMailServerFile );
  521.   end;
  522.   TheWorkingEMSL := TList.Create;
  523.   For Counter_1 := 0 to TheEMailServerList.Count - 1 do
  524.   begin
  525.     New( ThePSSRecord );
  526.     ThePSSRecord^ := PConnectionsRecord( TheEMailServerList.Items[ Counter_1 ] )^;
  527.     TheWorkingEMSL.Add( ThePSSRecord );
  528.   end;
  529. end;
  530.  
  531. procedure TCCINetCCForm.SaveEMailServerFile;
  532. var ThePSSRecord : PConnectionsRecord; { The TC Record pointer   }
  533.     PSSLName     : String;             { POP3SMTP Site List filename }
  534.     Counter_1    : Integer;            { Loop counter           }
  535. begin
  536.   { Set up the file name }
  537.   PSSLName := MailPath + '\PSSERVER.TCR';
  538.   { Assign the file }
  539.   AssignFile( TheEMailServerFile , PSSLName );
  540.   { Rewrite it }
  541.   Rewrite( TheEMailServerFile );
  542.   { run the list through the procedure }
  543.   for Counter_1 := 0 to TheEMailServerList.Count - 1 do
  544.   begin
  545.     { get the record from the list }
  546.     ThePSSRecord :=
  547.      PConnectionsRecord( TheEMailServerList.Items[ Counter_1 ] );
  548.     { Do the seek/write }
  549.     Seek( TheEMailServerFile , Counter_1 );
  550.     Write( TheEMailServerFile , ThePSSRecord^ );
  551.     { free the record }
  552.     Dispose( ThePSSRecord );
  553.   end;
  554.   { Close the file }
  555.   CloseFile( TheEMailServerFile );
  556.   { Free the list pointers }
  557.   TheEMailServerList.Free;
  558.   for Counter_1 := 0 to TheWorkingEMSL.Count - 1 do
  559.   begin
  560.     ThePSSRecord := PConnectionsRecord( TheWorkingEMSL.Items[ Counter_1 ] );
  561.     Dispose( ThePSSRecord );
  562.   end;
  563.   TheWorkingEMSL.Free;
  564. end;
  565.  
  566. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  567. procedure TCCINetCCForm.SetupEMailServerStatus;
  568. begin
  569.   { Set up display for main form }
  570.   CCINetCCForm.Tag := 6; { Email Tag }
  571.   CCINetCCForm.Caption := 'CC Internet Command Center -- EMail Mode';
  572.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  573.   CCINetCCForm.EMail2.Enabled := true;
  574.   CCINetCCForm.EMail1.Enabled := false;
  575.   CCINetCCForm.UsenetNws1.Enabled := false;
  576.   CCINetCCForm.FTP1.Enabled := false;
  577.   CCINetCCForm.Label1.Caption := 'Mail Server:';
  578.   CCINetCCForm.Button1.Caption := 'New Mail';
  579.   CCINetCCForm.Label4.Caption := 'Mailboxes';
  580.   CCINetCCForm.Label5.Caption := 'Messages';
  581. end;
  582.  
  583. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  584. procedure TCCINetCCForm.SetupEMailServersInfoDisplay;
  585. var Counter_1  : Integer;            { Loop counter        }
  586. begin
  587.   { Set tag for POP3SMTP stuff }
  588.   CCICInfoDlg.Tag := 6; { EMail Tag -- servers }
  589.   { set up caption of main label }
  590.   CCICInfoDlg.Label2.Caption := 'EMail Server Sites';
  591.   { hide outline panel }
  592.   CCICInfoDlg.Panel6.Top := 200;
  593.   CCICInfoDlg.panel6.Height := 144;
  594.   CCICInfoDlg.Panel6.Visible := false;
  595.   CCICInfoDlg.Panel5.Visible := true;
  596.   CCICInfoDlg.Panel8.Visible := true;
  597.   CCICInfoDlg.Panel9.Visible := true;
  598.   { clear the list box }
  599.   CCICInfoDlg.ListBox1.Visible := false;
  600.   CCICInfoDlg.ListBox2.Clear;
  601.   CCINetCCForm.ComboBox1.Clear;
  602.   { add profile strings to the list box }
  603.   for Counter_1 := 0 to TheEMailServerList.Count - 1 do
  604.   begin
  605.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  606.      TheEMailServerList.Items[ Counter_1 ] )^.CProfile );
  607.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  608.      TheEMailServerList.Items[ Counter_1 ] )^.CProfile );
  609.   end;
  610.   { Set up caption of special button }
  611.   CCICInfoDlg.Button1.Visible := false;
  612.   { Start with top record }
  613.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  614.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  615.   { put in data from top record and reset captions }
  616.   with PConnectionsRecord( TheEMailServerList.Items[ 0 ] )^ do
  617.   begin
  618.     with CCICInfoDlg do
  619.     begin
  620.       Edit1.Text := CProfile;
  621.       Panel2.Caption := '            Name:';
  622.       Edit2.Text := CIPAddress;
  623.       Panel3.Caption := '     IP Address:';
  624.       Edit3.Text := CUserName;
  625.       Panel5.Caption := '    User Name:';
  626.       CurrentEMRealPWString := CPassword;
  627.       case EMPasswordControlVector of
  628.         1 : Edit4.Text := CPassword;
  629.         2 : Edit4.Text := '**********';
  630.       end;
  631.       Panel8.Caption := '      Password:';
  632.       Edit5.Text := CStartDir;
  633.       Panel9.Caption := '    EMail Address:';
  634.     end;
  635.   end;
  636. end;
  637.  
  638.  
  639. procedure TCCINetCCForm.EnablePOP3SMTPMenus;
  640. begin
  641.   Button1.Caption := 'New Mail';
  642.   CheckMail1.Enabled := true;
  643.   CreateNewMessage1.Enabled := true;
  644.   ReplyToCurrentMessage1.Enabled := true;
  645.   SendCurrentMessage1.Enabled := true;
  646.   SendQueue1.Enabled := true;
  647.   MailServers1.Enabled := true;
  648.   MailBoxes1.Enabled := true;
  649.   Correspondents1.Enabled := true;
  650.   TrashMarkedMessages1.Enabled := true;
  651.   EmptyTrash1.Enabled := true;
  652. end;
  653.  
  654. procedure TCCINetCCForm.DisablePOP3SMTPMenus;
  655. begin
  656.   CheckMail1.Enabled := False;
  657.   CreateNewMessage1.Enabled := False;
  658.   ReplyToCurrentMessage1.Enabled := False;
  659.   SendCurrentMessage1.Enabled := False;
  660.   SendQueue1.Enabled := False;
  661.   MailServers1.Enabled := False;
  662.   MailBoxes1.Enabled := False;
  663.   Correspondents1.Enabled := False;
  664.   TrashMarkedMessages1.Enabled := False;
  665.   EmptyTrash1.Enabled := False;
  666.   EMail1.Enabled := true;
  667.   FTP1.Enabled := true;
  668.   UseNetNws1.Enabled := true;
  669.   IPAddress1.Enabled := true;
  670.   EMail2.Enabled := false;
  671. end;
  672.  
  673. { This is the FTP component constructor; it creates 2 sockets }
  674. constructor TFTPComponent.Create( AOwner : TComponent );
  675. begin
  676.   { do inherited create }
  677.   inherited Create( AOwner );
  678.   { Create sockets, put in their parents, and error procs }
  679.   Socket1 := TCCSocket.Create( Self );
  680.   Socket1.Parent := Self;
  681.   Socket1.OnErrorOccurred := FTPSocketsErrorOccurred;
  682.   Socket2 := TCCSocket.Create( Self );
  683.   Socket2.Parent := Self;
  684.   Socket2.OnErrorOccurred := FTPSocketsErrorOccurred;
  685.   { Set up booleans }
  686.   Connection_Established := false;
  687.   FTPCommandInProgress := false;
  688. end;
  689.  
  690. { This is the FTP component destructor; it frees 2 sockets }
  691. destructor TFTPComponent.Destroy;
  692. begin
  693.   { Free the sockets }
  694.   Socket1.Free;
  695.   Socket2.Free;
  696.   { and call inherited }
  697.   inherited Destroy;
  698. end;
  699.  
  700. function TFTPComponent.GetShortPathname( TheString : String ) : String;
  701. var HoldingString : String;
  702. begin
  703.   HoldingString := Copy( TheString , 1 , 3 );
  704.   HoldingString := HoldingString + '..\' + ExtractFileName( TheString );
  705.   Result := HoldingString;
  706. end;
  707.  
  708. function TFTPComponent.StripBrackets( TheString : String ) : String;
  709. var HoldingString : String;
  710.     HoldingPosition : Integer;
  711. begin
  712.   HoldingPosition := Pos( '[' , TheString );
  713.   if HoldingPosition = 0 then
  714.   begin
  715.     Result := TheString;
  716.     exit;
  717.   end
  718.   else
  719.   begin
  720.     HoldingString := Copy( TheString , HoldingPosition + 1 , 255 );
  721.     HoldingPosition := Pos( ']' , HoldingString );
  722.     if HoldingPosition = 0 then
  723.     begin
  724.       Result := HoldingString;
  725.       exit;
  726.     end
  727.     else
  728.     begin
  729.       HoldingString := Copy( HoldingString , 1 , HoldingPosition - 1 );
  730.       Result := HoldingString;
  731.       exit;
  732.     end;
  733.   end;
  734. end;
  735.  
  736. { This function takes a UNIX filespec and turns it into a Win16 filename }
  737. function TFTPComponent.GetWin16FileName( InputName : String ) : String;
  738. var WorkingString ,
  739.     HoldingString   : String; { Holding string }
  740. begin
  741.   WorkingString := ExtractFileExt( InputName );
  742.   if WorkingString = '' then
  743.   begin
  744.     if Length( InputName ) > 8 then
  745.      WorkingString := Copy( InputName , 1 , 8 ) else
  746.       WorkingString := InputName;
  747.   end
  748.   else
  749.   begin
  750.     if Length( WorkingString ) > 4 then
  751.      WorkingString := Copy( WorkingString , 1 , 4 );
  752.     HoldingString :=
  753.      Copy( InputName , 1 , Pos( WorkingString , InputName ) - 1 );
  754.     if Length( HoldingString ) > 8 then
  755.      HoldingString := Copy( HoldingString , 1 , 8 );
  756.     if HoldingString = '' then
  757.     begin
  758.       { Dot file }
  759.       HoldingString := Copy( InputName , 2 , 255 ) + '.TXT';
  760.       WorkingString := HoldingString;
  761.     end
  762.     else WorkingString := HoldingString + WorkingString;
  763.   end;
  764.   Result := WorkingString;
  765. end;
  766.  
  767. { This sends a local file in binary mode to the remote server }
  768. procedure TFTPComponent.SendBinaryLocalFile( LocalName : String );
  769. var TheReturnString : String;  { Internal string holder }
  770.     TheResult       : Integer; { Internal int holder    }
  771.     Through         : Boolean;
  772.     FileNamePChar   : array[ 0 .. 255 ] of char;
  773.     OutputFileHandle : Integer;
  774.     TotalBytesSent ,
  775.     BytesRead ,
  776.     FileToSendSize    : Longint;
  777.     CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
  778. begin
  779.   LocalName := ExpandFileName( LocalName );
  780.   StrPCopy( FileNamePChar , LocalName );
  781.   OutputFileHandle := _lopen( FileNamePChar , 0 );
  782.   if OutputFileHandle = -1 then
  783.   begin
  784.     MessageDlg( 'Cannot Open local file ' + LocalName ,
  785.      mtError , [mbOK] , 0 );
  786.     exit;
  787.   end;
  788.   FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  789.   _llseek( OutputFileHandle , 0 , 0 );
  790.   TheReturnString :=
  791.    DoCStyleFormat( 'TYPE I' ,
  792.     [ nil ] );
  793.   { Put result in progress and status line }
  794.   AddProgressText( TheReturnString );
  795.   ShowProgressText( TheReturnString );
  796.   { Send Password sequence }
  797.   TheResult := PerformFTPCommand( 'TYPE I',
  798.                                   [ nil ] );
  799.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  800.   begin
  801.     FTPCommandInProgress := false;
  802.     exit;
  803.   end;
  804.   repeat
  805.     TheResult := GetFTPServerResponse( TheReturnString );
  806.     { Put result in progress and status line }
  807.     AddProgressText( TheReturnString );
  808.     ShowProgressText( TheReturnString );
  809.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  810.   FTPCommandInProgress := false;
  811.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  812.   begin
  813.     { Do clever C formatting trick }
  814.     TheReturnString :=
  815.      DoCStyleFormat( 'FTP File Send Failed!' ,
  816.       [ nil ] );
  817.     { Put result in progress and status line }
  818.     AddProgressText( TheReturnString );
  819.     ShowProgressErrorText( TheReturnString );
  820.     { leave }
  821.     exit;
  822.   end
  823.   else
  824.   begin
  825.     { Set up socket 2 for listening }
  826.     Socket2.AsynchMode := False;
  827.     Socket2.NonAsynchTimeoutValue := 60;
  828.     { do a listen and send command to server that this is receipt socket }
  829.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  830.     begin
  831.       Socket2.CCSockCancelListen;
  832.       exit;
  833.     end;
  834.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  835.     TheReturnString :=
  836.      DoCStyleFormat( 'STOR %s' ,
  837.       [ ExtractFileName( LocalName ) ] );
  838.     { Put result in progress and status line }
  839.     AddProgressText( TheReturnString );
  840.     ShowProgressText( TheReturnString );
  841.     TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName ) ] );
  842.     GetFTPServerResponse( TheReturnString );
  843.     AddProgressText( TheReturnString );
  844.     ShowProgressText( TheReturnString );
  845.     Socket1.NonAsynchTimeoutValue := 30;
  846.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  847.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  848.     begin
  849.       TheReturnString :=
  850.        DoCStyleFormat( 'Could not create remote file!' ,
  851.         [ nil ] );
  852.       { Put result in progress and status line }
  853.       AddProgressText( TheReturnString );
  854.       ShowProgressErrorText( TheReturnString );
  855.       Socket2.CCSockCancelListen;
  856.       exit;
  857.     end;
  858.     Socket2.CCSockAccept;
  859.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  860.     begin
  861.       TheReturnString :=
  862.        DoCStyleFormat( 'Could not establish send socket!' ,
  863.         [ nil ] );
  864.       { Put result in progress and status line }
  865.       AddProgressText( TheReturnString );
  866.       ShowProgressErrorText( TheReturnString );
  867.       exit;
  868.     end;
  869.     Through := false;
  870.     TotalBytesSent := 0;
  871.     BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  872.     repeat
  873.       if BytesRead = 0 then Through := true;
  874.       if BytesRead > 0 then
  875.       begin
  876.         CopyBuffer[ 0 ] := Chr( BytesRead );
  877.         Socket2.StringData := TheReturnString;
  878.         TotalBytesSent := TotalBytesSent + BytesRead;
  879.         UpdateGauge( TotalBytesSent , FileToSendSize );
  880.         BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  881.         if BytesRead = -1 then
  882.         begin
  883.           MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
  884.           GlobalAbortedFlag := True;
  885.         end;
  886.       end;
  887.       if GlobalAbortedFlag then
  888.       begin
  889.         Socket1.OutOfBand := 'ABOR'+#13#10;
  890.         repeat
  891.           TheResult := GetFTPServerResponse( TheReturnString );
  892.           { Put result in progress and status line }
  893.           AddProgressText( TheReturnString );
  894.           ShowProgressText( TheReturnString );
  895.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  896.         exit;
  897.       end;
  898.     until Through;
  899.     FTPCommandInProgress := false;
  900.     { cancel listening on second socket and close it }
  901.     Socket2.CCSockCancelListen;
  902.     Socket2.CCSockClose;
  903.     TheReturnString := 'Transfer Succeeded' + #13#10;
  904.     AddProgressText( TheReturnString );
  905.     ShowProgressText( TheReturnString );
  906.     FTPCommandInProgress := false;
  907.     PerformFTPCommand( 'TYPE A',
  908.                                     [ nil ] );
  909.     Through := false;
  910.     repeat
  911.       GetFTPServerResponse( TheReturnString );
  912.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  913.        Through := true;
  914.       { Put result in progress and status line }
  915.       AddProgressText( TheReturnString );
  916.       ShowProgressText( TheReturnString );
  917.     until (( GlobalAbortedFlag ) or Through );
  918.   end;
  919.   _lclose( OutputFileHandle );
  920.   FTPCommandInProgress := false;
  921. end;
  922.  
  923. { This sends a local file in ascii mode to remote server }
  924. procedure TFTPComponent.SendASCIILocalFile( LocalName : String );
  925. var TheReturnString : String;  { Internal string holder }
  926.     TheResult       : Integer; { Internal int holder    }
  927.     Through         : Boolean;
  928.     FileNamePChar   : array[ 0 .. 255 ] of char;
  929.     OutputFileHandle : Integer;
  930.     TotalBytesSent ,
  931.     BytesRead ,
  932.     FileToSendSize    : Longint;
  933.     CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
  934. begin
  935.   LocalName := ExpandFileName( LocalName );
  936.   StrPCopy( FileNamePChar , LocalName );
  937.   OutputFileHandle := _lopen( FileNamePChar , 0 );
  938.   if OutputFileHandle = -1 then
  939.   begin
  940.     MessageDlg( 'Cannot Open local file ' + LocalName ,
  941.      mtError , [mbOK] , 0 );
  942.     exit;
  943.   end;
  944.   FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  945.   _llseek( OutputFileHandle , 0 , 0 );
  946.   TheReturnString :=
  947.    DoCStyleFormat( 'TYPE A' ,
  948.     [ nil ] );
  949.   { Put result in progress and status line }
  950.   AddProgressText( TheReturnString );
  951.   ShowProgressText( TheReturnString );
  952.   { Send Password sequence }
  953.   TheResult := PerformFTPCommand( 'TYPE A',
  954.                                   [ nil ] );
  955.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  956.   begin
  957.     FTPCommandInProgress := false;
  958.     exit;
  959.   end;
  960.   repeat
  961.     TheResult := GetFTPServerResponse( TheReturnString );
  962.     { Put result in progress and status line }
  963.     AddProgressText( TheReturnString );
  964.     ShowProgressText( TheReturnString );
  965.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  966.   FTPCommandInProgress := false;
  967.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  968.   begin
  969.     { Do clever C formatting trick }
  970.     TheReturnString :=
  971.      DoCStyleFormat( 'FTP File Send Failed!' ,
  972.       [ nil ] );
  973.     { Put result in progress and status line }
  974.     AddProgressText( TheReturnString );
  975.     ShowProgressErrorText( TheReturnString );
  976.     { leave }
  977.     exit;
  978.   end
  979.   else
  980.   begin
  981.     { Set up socket 2 for listening }
  982.     Socket2.AsynchMode := False;
  983.     Socket2.NonAsynchTimeoutValue := 60;
  984.     { do a listen and send command to server that this is receipt socket }
  985.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  986.     begin
  987.       Socket2.CCSockCancelListen;
  988.       exit;
  989.     end;
  990.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  991.     TheReturnString :=
  992.      DoCStyleFormat( 'STOR %s' ,
  993.       [ ExtractFileName( LocalName ) ] );
  994.     { Put result in progress and status line }
  995.     AddProgressText( TheReturnString );
  996.     ShowProgressText( TheReturnString );
  997.     TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName )]);
  998.     GetFTPServerResponse( TheReturnString );
  999.     AddProgressText( TheReturnString );
  1000.     ShowProgressText( TheReturnString );
  1001.     Socket1.NonAsynchTimeoutValue := 30;
  1002.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  1003.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  1004.     begin
  1005.       TheReturnString :=
  1006.        DoCStyleFormat( 'Could not create remote file!' ,
  1007.         [ nil ] );
  1008.       { Put result in progress and status line }
  1009.       AddProgressText( TheReturnString );
  1010.       ShowProgressErrorText( TheReturnString );
  1011.       Socket2.CCSockCancelListen;
  1012.       exit;
  1013.     end;
  1014.     Socket2.CCSockAccept;
  1015.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1016.     begin
  1017.       TheReturnString :=
  1018.        DoCStyleFormat( 'Could not establish send socket!' ,
  1019.         [ nil ] );
  1020.       { Put result in progress and status line }
  1021.       AddProgressText( TheReturnString );
  1022.       ShowProgressErrorText( TheReturnString );
  1023.       exit;
  1024.     end;
  1025.     Through := false;
  1026.     TotalBytesSent := 0;
  1027.     BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  1028.     repeat
  1029.       if BytesRead = 0 then Through := true;
  1030.       if BytesRead > 0 then
  1031.       begin
  1032.         CopyBuffer[ 0 ] := Chr( BytesRead );
  1033.         Socket2.StringData := TheReturnString;
  1034.         TotalBytesSent := TotalBytesSent + BytesRead;
  1035.         UpdateGauge( TotalBytesSent , FileToSendSize );
  1036.         BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  1037.         if BytesRead = -1 then
  1038.         begin
  1039.           MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
  1040.           GlobalAbortedFlag := True;
  1041.         end;
  1042.       end;
  1043.       if GlobalAbortedFlag then
  1044.       begin
  1045.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1046.         repeat
  1047.           TheResult := GetFTPServerResponse( TheReturnString );
  1048.           { Put result in progress and status line }
  1049.           AddProgressText( TheReturnString );
  1050.           ShowProgressText( TheReturnString );
  1051.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1052.         exit;
  1053.       end;
  1054.     until Through;
  1055.     { cancel listening on second socket and close it }
  1056.     Socket2.CCSockCancelListen;
  1057.     Socket2.CCSockClose;
  1058.     TheReturnString := 'Transfer Succeeded' + #13#10;
  1059.     AddProgressText( TheReturnString );
  1060.     ShowProgressText( TheReturnString );
  1061.     FTPCommandInProgress := false;
  1062.     PerformFTPCommand( 'TYPE A', [ nil ] );
  1063.     Through := false;
  1064.     repeat
  1065.       GetFTPServerResponse( TheReturnString );
  1066.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1067.        Through := true;
  1068.       { Put result in progress and status line }
  1069.       AddProgressText( TheReturnString );
  1070.       ShowProgressText( TheReturnString );
  1071.     until (( GlobalAbortedFlag ) or Through );
  1072.   end;
  1073.   _lclose( OutputFileHandle );
  1074.   FTPCommandInProgress := false;
  1075. end;
  1076.  
  1077. { This function strips out the FTP response for bytes to send }
  1078. function TFTPComponent.GetTotalBytesToReceive( TheString : String ) : Longint;
  1079. var
  1080.   LeftPosition ,
  1081.   RightPosition  : integer;
  1082.   TempString     : string;
  1083. begin
  1084.   LeftPosition := Pos( '(' , TheString );
  1085.   TempString := Copy( TheString ,
  1086.                       LeftPosition + 1 , 255 );
  1087.   RightPosition := Pos( ' ' , TempString );
  1088.   if (( LeftPosition = 0 ) or ( RightPosition = 0 )) then
  1089.   begin
  1090.     Result := 0;
  1091.     exit;
  1092.   end;
  1093.   if RightPosition <> 0 then
  1094.     TempString := Copy( TempString , 1 , RightPosition - 1  );
  1095.   try
  1096.     Result := StrToInt( TempString );
  1097.   except
  1098.     on EConvertError do Result := 0;
  1099.   end;
  1100. end;
  1101.  
  1102. procedure TFTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
  1103. begin
  1104.   CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
  1105. end;
  1106.  
  1107. { This sends FTP progress text to the Inet form }
  1108. procedure TFTPComponent.AddProgressText( WhatText : String );
  1109. begin
  1110.   CCInetCCForm.AddProgressText( WhatText );
  1111. end;
  1112.  
  1113. { This sends FTP progress text to the Inet form }
  1114. procedure TFTPComponent.ShowProgressText( WhatText : String );
  1115. begin
  1116.   CCInetCCForm.ShowProgressText( WhatText );
  1117. end;
  1118.  
  1119. { This procedure receives a binary remote file }
  1120. procedure TFTPComponent.ReceiveASCIIRemoteFileToMemo( RemoteName : String );
  1121. var TheReturnString : String;  { Internal string holder }
  1122.     TheResult       : Integer; { Internal int holder    }
  1123.     Through         : Boolean;
  1124.     TotalBytesSent ,
  1125.     FileToGetSize    : Longint;
  1126. begin
  1127.   TheReturnString :=
  1128.    DoCStyleFormat( 'TYPE A' ,
  1129.     [ nil ] );
  1130.   { Put result in progress and status line }
  1131.   AddProgressText( TheReturnString );
  1132.   ShowProgressText( TheReturnString );
  1133.   { Send Password sequence }
  1134.   FTPCommandInProgress := false;
  1135.   TheResult := PerformFTPCommand( 'TYPE A',
  1136.                                   [ nil ] );
  1137.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1138.   begin
  1139.     FTPCommandInProgress := false;
  1140.     exit;
  1141.   end;
  1142.   repeat
  1143.     TheResult := GetFTPServerResponse( TheReturnString );
  1144.     { Put result in progress and status line }
  1145.     AddProgressText( TheReturnString );
  1146.     ShowProgressText( TheReturnString );
  1147.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1148.   FTPCommandInProgress := false;
  1149.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1150.   begin
  1151.     { Do clever C formatting trick }
  1152.     TheReturnString :=
  1153.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  1154.       [ nil ] );
  1155.     { Put result in progress and status line }
  1156.     AddProgressText( TheReturnString );
  1157.     ShowProgressErrorText( TheReturnString );
  1158.     { leave }
  1159.     exit;
  1160.   end
  1161.   else
  1162.   begin
  1163.     { Set up socket 2 for listening }
  1164.     Socket2.AsynchMode := False;
  1165.     Socket2.NonAsynchTimeoutValue := 60;
  1166.     { do a listen and send command to server that this is receipt socket }
  1167.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  1168.     begin
  1169.       Socket2.CCSockCancelListen;
  1170.       exit;
  1171.     end;
  1172.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1173.     TheReturnString :=
  1174.      DoCStyleFormat( 'RETR %s' ,
  1175.       [ RemoteName ] );
  1176.     { Put result in progress and status line }
  1177.     AddProgressText( TheReturnString );
  1178.     ShowProgressText( TheReturnString );
  1179.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  1180.     GetFTPServerResponse( TheReturnString );
  1181.     AddProgressText( TheReturnString );
  1182.     ShowProgressText( TheReturnString );
  1183.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  1184.     Socket1.NonAsynchTimeoutValue := 30;
  1185.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  1186.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  1187.     begin
  1188.       TheReturnString :=
  1189.        DoCStyleFormat( 'Could not obtain remote file!' ,
  1190.         [ nil ] );
  1191.       { Put result in progress and status line }
  1192.       AddProgressText( TheReturnString );
  1193.       ShowProgressErrorText( TheReturnString );
  1194.       Socket2.CCSockCancelListen;
  1195.       exit;
  1196.     end;
  1197.     Socket2.CCSockAccept;
  1198.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1199.     begin
  1200.       TheReturnString :=
  1201.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1202.         [ nil ] );
  1203.       { Put result in progress and status line }
  1204.       AddProgressText( TheReturnString );
  1205.       ShowProgressErrorText( TheReturnString );
  1206.       exit;
  1207.     end;
  1208.     Through := false;
  1209.     TotalBytesSent := 0;
  1210.     repeat
  1211.       TheReturnString := Socket2.StringData;
  1212.       if Length( TheReturnString ) = 0 then Through := true;
  1213.       if Length( TheReturnString ) > 0 then
  1214.       begin
  1215.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1216.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1217.         { Put result in progress and status line }
  1218.         AddProgressText( TheReturnString );
  1219.         ShowProgressText( TheReturnString );
  1220.       end;
  1221.       if GlobalAbortedFlag then
  1222.       begin
  1223.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1224.         repeat
  1225.           TheResult := GetFTPServerResponse( TheReturnString );
  1226.           { Put result in progress and status line }
  1227.           AddProgressText( TheReturnString );
  1228.           ShowProgressText( TheReturnString );
  1229.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1230.         exit;
  1231.       end;
  1232.     until Through;
  1233.     { cancel listening on second socket and close it }
  1234.     Socket2.CCSockCancelListen;
  1235.     Socket2.CCSockClose;
  1236.     FTPCommandInProgress := false;
  1237.     PerformFTPCommand( 'TYPE A', [ nil ] );
  1238.     Through := false;
  1239.     repeat
  1240.       GetFTPServerResponse( TheReturnString );
  1241.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1242.        Through := true;
  1243.       { Put result in progress and status line }
  1244.       AddProgressText( TheReturnString );
  1245.       ShowProgressText( TheReturnString );
  1246.     until (( GlobalAbortedFlag ) or Through );
  1247.   end;
  1248.   FTPCommandInProgress := false;
  1249. end;
  1250.  
  1251. { This procedure receives a binary remote file }
  1252. procedure TFTPComponent.ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
  1253. var TheReturnString : String;  { Internal string holder }
  1254.     TheResult       : Integer; { Internal int holder    }
  1255.     Through         : Boolean;
  1256.     FileNamePChar   : array[ 0 .. 255 ] of char;
  1257.     OutputFileHandle : Integer;
  1258.     TotalBytesSent ,
  1259.     FileToGetSize    : Longint;
  1260.     CopyBuffer       : array[ 0 .. 255 ] of char;
  1261. begin
  1262.   LocalName := ExpandFileName( LocalName );
  1263.   StrPCopy( FileNamePChar , LocalName );
  1264.   OutputFileHandle := _lcreat( FileNamePChar , 0 );
  1265.   if OutputFileHandle = -1 then
  1266.   begin
  1267.     MessageDlg( 'Cannot Create local file ' + LocalName ,
  1268.      mtError , [mbOK] , 0 );
  1269.     exit;
  1270.   end;
  1271.   TheReturnString :=
  1272.    DoCStyleFormat( 'TYPE A' ,
  1273.     [ nil ] );
  1274.   { Put result in progress and status line }
  1275.   AddProgressText( TheReturnString );
  1276.   ShowProgressText( TheReturnString );
  1277.   { Send Password sequence }
  1278.   TheResult := PerformFTPCommand( 'TYPE A',
  1279.                                   [ nil ] );
  1280.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1281.   begin
  1282.     FTPCommandInProgress := false;
  1283.     exit;
  1284.   end;
  1285.   repeat
  1286.     TheResult := GetFTPServerResponse( TheReturnString );
  1287.     { Put result in progress and status line }
  1288.     AddProgressText( TheReturnString );
  1289.     ShowProgressText( TheReturnString );
  1290.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1291.   FTPCommandInProgress := false;
  1292.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1293.   begin
  1294.     { Do clever C formatting trick }
  1295.     TheReturnString :=
  1296.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  1297.       [ nil ] );
  1298.     { Put result in progress and status line }
  1299.     AddProgressText( TheReturnString );
  1300.     ShowProgressErrorText( TheReturnString );
  1301.     { leave }
  1302.     exit;
  1303.   end
  1304.   else
  1305.   begin
  1306.     { Set up socket 2 for listening }
  1307.     Socket2.AsynchMode := False;
  1308.     Socket2.NonAsynchTimeoutValue := 60;
  1309.     { do a listen and send command to server that this is receipt socket }
  1310.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  1311.     begin
  1312.       Socket2.CCSockCancelListen;
  1313.       exit;
  1314.     end;
  1315.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1316.     TheReturnString :=
  1317.      DoCStyleFormat( 'RETR %s' ,
  1318.       [ RemoteName ] );
  1319.     { Put result in progress and status line }
  1320.     AddProgressText( TheReturnString );
  1321.     ShowProgressText( TheReturnString );
  1322.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  1323.     GetFTPServerResponse( TheReturnString );
  1324.     AddProgressText( TheReturnString );
  1325.     ShowProgressText( TheReturnString );
  1326.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  1327.     Socket1.NonAsynchTimeoutValue := 30;
  1328.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  1329.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  1330.     begin
  1331.       TheReturnString :=
  1332.        DoCStyleFormat( 'Could not obtain remote file!' ,
  1333.         [ nil ] );
  1334.       { Put result in progress and status line }
  1335.       AddProgressText( TheReturnString );
  1336.       ShowProgressErrorText( TheReturnString );
  1337.       Socket2.CCSockCancelListen;
  1338.       exit;
  1339.     end;
  1340.     Socket2.CCSockAccept;
  1341.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1342.     begin
  1343.       TheReturnString :=
  1344.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1345.         [ nil ] );
  1346.       { Put result in progress and status line }
  1347.       AddProgressText( TheReturnString );
  1348.       ShowProgressErrorText( TheReturnString );
  1349.       exit;
  1350.     end;
  1351.     Through := false;
  1352.     TotalBytesSent := 0;
  1353.     repeat
  1354.       TheReturnString := Socket2.StringData;
  1355.       if Length( TheReturnString ) = 0 then Through := true;
  1356.       if Length( TheReturnString ) > 0 then
  1357.       begin
  1358.         StrPCopy( CopyBuffer , TheReturnString );
  1359.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1360.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1361.         if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
  1362.          = -1 then
  1363.         begin
  1364.           MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
  1365.           GlobalAbortedFlag := True;
  1366.         end;
  1367.       end;
  1368.       if GlobalAbortedFlag then
  1369.       begin
  1370.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1371.         repeat
  1372.           TheResult := GetFTPServerResponse( TheReturnString );
  1373.           { Put result in progress and status line }
  1374.           AddProgressText( TheReturnString );
  1375.           ShowProgressText( TheReturnString );
  1376.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1377.         exit;
  1378.       end;
  1379.     until Through;
  1380.     { cancel listening on second socket and close it }
  1381.     Socket2.CCSockCancelListen;
  1382.     Socket2.CCSockClose;
  1383.     FTPCommandInProgress := false;
  1384.     PerformFTPCommand( 'TYPE A', [ nil ] );
  1385.     Through := false;
  1386.     repeat
  1387.       GetFTPServerResponse( TheReturnString );
  1388.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1389.        Through := true;
  1390.       { Put result in progress and status line }
  1391.       AddProgressText( TheReturnString );
  1392.       ShowProgressText( TheReturnString );
  1393.     until (( GlobalAbortedFlag ) or Through );
  1394.   end;
  1395.   _lclose( OutputFileHandle );
  1396.   FTPCommandInProgress := false;
  1397. end;
  1398.  
  1399. { This procedure receives a binary remote file }
  1400. procedure TFTPComponent.ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
  1401. var TheReturnString : String;  { Internal string holder }
  1402.     TheResult       : Integer; { Internal int holder    }
  1403.     Through         : Boolean;
  1404.     FileNamePChar   : array[ 0 .. 255 ] of char;
  1405.     OutputFileHandle : Integer;
  1406.     TotalBytesSent ,
  1407.     FileToGetSize    : Longint;
  1408.     CopyBuffer       : array[ 0 .. 255 ] of char;
  1409. begin
  1410.   LocalName := ExpandFileName( LocalName );
  1411.   StrPCopy( FileNamePChar , LocalName );
  1412.   OutputFileHandle := _lcreat( FileNamePChar , 0 );
  1413.   if OutputFileHandle = -1 then
  1414.   begin
  1415.     MessageDlg( 'Cannot Create local file ' + LocalName ,
  1416.      mtError , [mbOK] , 0 );
  1417.     exit;
  1418.   end;
  1419.   TheReturnString :=
  1420.    DoCStyleFormat( 'TYPE I' ,
  1421.     [ nil ] );
  1422.   { Put result in progress and status line }
  1423.   AddProgressText( TheReturnString );
  1424.   ShowProgressText( TheReturnString );
  1425.   { Send Password sequence }
  1426.   TheResult := PerformFTPCommand( 'TYPE I',
  1427.                                   [ nil ] );
  1428.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1429.   begin
  1430.     FTPCommandInProgress := false;
  1431.     exit;
  1432.   end;
  1433.   repeat
  1434.     TheResult := GetFTPServerResponse( TheReturnString );
  1435.     { Put result in progress and status line }
  1436.     AddProgressText( TheReturnString );
  1437.     ShowProgressText( TheReturnString );
  1438.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1439.   FTPCommandInProgress := false;
  1440.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1441.   begin
  1442.     { Do clever C formatting trick }
  1443.     TheReturnString :=
  1444.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  1445.       [ nil ] );
  1446.     { Put result in progress and status line }
  1447.     AddProgressText( TheReturnString );
  1448.     ShowProgressErrorText( TheReturnString );
  1449.     { leave }
  1450.     exit;
  1451.   end
  1452.   else
  1453.   begin
  1454.     { Set up socket 2 for listening }
  1455.     Socket2.AsynchMode := False;
  1456.     Socket2.NonAsynchTimeoutValue := 60;
  1457.     { do a listen and send command to server that this is receipt socket }
  1458.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  1459.     begin
  1460.       Socket2.CCSockCancelListen;
  1461.       exit;
  1462.     end;
  1463.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1464.     TheReturnString :=
  1465.      DoCStyleFormat( 'RETR %s' ,
  1466.       [ RemoteName ] );
  1467.     { Put result in progress and status line }
  1468.     AddProgressText( TheReturnString );
  1469.     ShowProgressText( TheReturnString );
  1470.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  1471.     GetFTPServerResponse( TheReturnString );
  1472.     AddProgressText( TheReturnString );
  1473.     ShowProgressText( TheReturnString );
  1474.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  1475.     Socket1.NonAsynchTimeoutValue := 30;
  1476.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  1477.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  1478.     begin
  1479.       TheReturnString :=
  1480.        DoCStyleFormat( 'Could not obtain remote file!' ,
  1481.         [ nil ] );
  1482.       { Put result in progress and status line }
  1483.       AddProgressText( TheReturnString );
  1484.       ShowProgressErrorText( TheReturnString );
  1485.       Socket2.CCSockCancelListen;
  1486.       exit;
  1487.     end;
  1488.     Socket2.CCSockAccept;
  1489.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1490.     begin
  1491.       TheReturnString :=
  1492.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1493.         [ nil ] );
  1494.       { Put result in progress and status line }
  1495.       AddProgressText( TheReturnString );
  1496.       ShowProgressErrorText( TheReturnString );
  1497.       exit;
  1498.     end;
  1499.     Through := false;
  1500.     TotalBytesSent := 0;
  1501.     repeat
  1502.       TheReturnString := Socket2.StringData;
  1503.       if Length( TheReturnString ) = 0 then Through := true;
  1504.       if Length( TheReturnString ) > 0 then
  1505.       begin
  1506.         StrPCopy( CopyBuffer , TheReturnString );
  1507.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1508.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1509.         if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
  1510.          = -1 then
  1511.         begin
  1512.           MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
  1513.           GlobalAbortedFlag := True;
  1514.         end;
  1515.       end;
  1516.       if GlobalAbortedFlag then
  1517.       begin
  1518.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1519.         repeat
  1520.           TheResult := GetFTPServerResponse( TheReturnString );
  1521.           { Put result in progress and status line }
  1522.           AddProgressText( TheReturnString );
  1523.           ShowProgressText( TheReturnString );
  1524.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1525.         exit;
  1526.       end;
  1527.     until Through;
  1528.     { cancel listening on second socket and close it }
  1529.     Socket2.CCSockCancelListen;
  1530.     Socket2.CCSockClose;
  1531.     FTPCommandInProgress := false;
  1532.     PerformFTPCommand( 'TYPE A', [ nil ] );
  1533.     Through := false;
  1534.     repeat
  1535.       GetFTPServerResponse( TheReturnString );
  1536.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1537.        Through := true;
  1538.       { Put result in progress and status line }
  1539.       AddProgressText( TheReturnString );
  1540.       ShowProgressText( TheReturnString );
  1541.     until (( GlobalAbortedFlag ) or Through );
  1542.   end;
  1543.   _lclose( OutputFileHandle );
  1544.   FTPCommandInProgress := false;
  1545. end;
  1546.  
  1547. { This sends FTP progress text to the Inet form }
  1548. procedure TFTPComponent.ShowProgressErrorText( WhatText : String );
  1549. begin
  1550.   CCInetCCForm.ShowProgressErrorText( WhatText );
  1551. end;
  1552.  
  1553. { This is a core function! It performs an FTP command and if no timeout }
  1554. { return a preliminary ok.                                              }
  1555. function TFTPComponent.PerformFTPCommand(
  1556.                  TheCommand        : string;
  1557.            const TheArguments      : array of const ) : Integer;
  1558. var TheBuffer : string; { Text buffer }
  1559. begin
  1560.   { If command in progress send back -1 error }
  1561.   if FTPCommandInProgress then
  1562.   begin
  1563.     Result := -1;
  1564.     exit;
  1565.   end;
  1566.   { Set status variable }
  1567.   FTPCommandInProgress := True;
  1568.   { Set global error code }
  1569.   GlobalErrorCode := 0;
  1570.   { Format output string }
  1571.   TheBuffer := Format( TheCommand , TheArguments );
  1572.   { Preset failure code }
  1573.   Result := TCPIP_STATUS_FATAL_ERROR;
  1574.   { If invalid socket or no connection abort }
  1575.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  1576.    exit;
  1577.   { Send the buffer plus EOL chars }
  1578.   Socket1.StringData := TheBuffer + #13#10;
  1579.   { if abort due to timeout or other error exit }
  1580.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1581.   { Otherwise return preliminary code }
  1582.   Result := TCPIP_STATUS_PRELIMINARY;
  1583. end;
  1584.  
  1585. { This function gets up to 255 chars of data plus a return code from FTP serv }
  1586. function TFTPComponent.GetFTPServerResponse(
  1587.           var ResponseString : String ) : integer;
  1588. var
  1589.   { Buffer string for response line }
  1590.   TheBuffer     : string;
  1591.   { Pointer to the response string }
  1592.   BufferPointer : array[0..255] of char absolute TheBuffer;
  1593.   { Character to check for response code }
  1594.   ResponseChar   : char;
  1595.   { Pointers into returned string }
  1596.   TheIndex ,
  1597.   TheLength     : integer;
  1598.   { Control variable }
  1599.   LeftoversInPan ,
  1600.   Finished      : Boolean;
  1601. begin
  1602.   { Preset fatal error }
  1603.   Result := TCPIP_STATUS_FATAL_ERROR;
  1604.   { Start loop control }
  1605.   LeftoversInPan := false;
  1606.   Finished := false;
  1607.   repeat
  1608.     { Do a peek }
  1609.     TheBuffer := Socket1.PeekData;
  1610.     { If timeout or other error exit }
  1611.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1612.     { Find end of line character }
  1613.     TheIndex := Pos( #10 , TheBuffer );
  1614.     if TheIndex = 0 then
  1615.     begin
  1616.       TheIndex := Pos( #13 , TheBuffer );
  1617.       if TheIndex = 0 then
  1618.       begin
  1619.         TheIndex := Pos( #0 , TheBuffer );
  1620.         if TheIndex = 0 then
  1621.         begin
  1622.           TheIndex := Length( TheBuffer );
  1623.           LeftoversInPan := True;
  1624.           LeftoverText := LeftoverText + TheBuffer;
  1625.           LeftoversOnTable := false;
  1626.         end;
  1627.       end;
  1628.     end;
  1629.     { If an end of line then process the line }
  1630.     if TheIndex > 0 then
  1631.     begin
  1632.       { Get length of string }
  1633.       TheLength := TheIndex;
  1634.       { Receive actual data }
  1635.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  1636.                              @BufferPointer[ 1 ] ,
  1637.                              TheLength              );
  1638.       { Abort if timeout or error }
  1639.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1640.       { Put in the length byte }
  1641.       BufferPointer[ 0 ] := Chr( TheLength );
  1642.       if LeftOversOnTable then
  1643.       begin
  1644.         LeftOversOnTable := false;
  1645.         ResponseString := LeftoverText + TheBuffer;
  1646.         TheBuffer := ResponseString;
  1647.         LeftoverText := '';
  1648.       end;
  1649.       if LeftoversInPan then
  1650.       begin
  1651.         LeftoversInPan := false;
  1652.         LeftoversOnTable := true;
  1653.       end;
  1654.       { If not a continuation line }
  1655.       if TheBuffer[ 4 ] <> '-' then
  1656.       begin
  1657.         { Get first number character }
  1658.         ResponseChar := TheBuffer[ 1 ];
  1659.         { Get the value of the number from 1 to 5 }
  1660.         if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  1661.         begin
  1662.           Finished := true;
  1663.           Result := Ord( ResponseChar ) - 48;
  1664.         end;
  1665.       end
  1666.       else
  1667.       begin
  1668.         { otherwise return preliminary result }
  1669.         Finished := true;
  1670.         Result := TCPIP_STATUS_PRELIMINARY;
  1671.       end;
  1672.     end
  1673.     else
  1674.     begin
  1675.     end;
  1676.   until ( Finished and ( not LeftoversOnTable ));
  1677.   { Return buffer as response string }
  1678.   ResponseString := TheBuffer;
  1679. end;
  1680.  
  1681. { Boilerplate error routine }
  1682. procedure TFTPComponent.FTPSocketsErrorOccurred( Sender     : TObject;
  1683.                                                  ErrorCode  : Integer;
  1684.                                                  TheMessage : String   );
  1685. begin
  1686.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  1687. end;
  1688.  
  1689. { This is the FTP components initial connection routine }
  1690. function TFTPComponent.EstablishConnection(
  1691.           PCRPointer : PConnectionsRecord ) : Boolean;
  1692. var TheReturnString : String;  { Internal string holder }
  1693.     TheResult       : Integer; { Internal int holder    }
  1694. begin
  1695.   { Set default FTP Port value }
  1696.   Socket1.PortName := '21';
  1697.   { Get the ip address from the record }
  1698.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  1699.   { Set blocking mode }
  1700.   Socket1.AsynchMode := False;
  1701.   { Clear condition variables }
  1702.   GlobalErrorCode := 0;
  1703.   GlobalAbortedFlag := false;
  1704.   { Actually attempt to connect }
  1705.   Socket1.CCSockConnect;
  1706.   { Check if connected }
  1707.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  1708.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  1709.   begin { Didn't connect; signal error and abort }
  1710.     { Do clever C formatting trick }
  1711.     TheReturnString :=
  1712.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1713.       [ PCRPointer^.CIPAddress ] );
  1714.     { Put result in progress and status line }
  1715.     AddProgressText( TheReturnString );
  1716.     ShowProgressErrorText( TheReturnString );
  1717.     { Signal error }
  1718.     Result := False;
  1719.     { leave }
  1720.     exit;
  1721.   end
  1722.   else
  1723.   begin
  1724.     Connection_Established := true;
  1725.     { Signal successful connection }
  1726.     TheReturnString := DoCStyleFormat(
  1727.       'Connected on Local port: %s with IP: %s',
  1728.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  1729.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  1730.     { Put result in progress and status line }
  1731.     CCINetCCForm.AddProgressText( TheReturnString );
  1732.     CCINetCCForm.ShowProgressText( TheReturnString );
  1733.     TheReturnString := DoCStyleFormat(
  1734.      'Connected to Remote port: %s with IP: %s',
  1735.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  1736.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  1737.     { Put result in progress and status line }
  1738.     CCINetCCForm.AddProgressText( TheReturnString );
  1739.     CCINetCCForm.ShowProgressText( TheReturnString );
  1740.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  1741.      [ Socket1.IPAddressName ]);
  1742.     { Put result in progress and status line }
  1743.     CCINetCCForm.AddProgressText( TheReturnString );
  1744.     CCINetCCForm.ShowProgressText( TheReturnString );
  1745.     repeat
  1746.       TheResult := GetFTPServerResponse( TheReturnString );
  1747.       { Put result in progress and status line }
  1748.       AddProgressText( TheReturnString );
  1749.       ShowProgressText( TheReturnString );
  1750.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1751.     if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1752.     begin
  1753.       { Do clever C formatting trick }
  1754.       TheReturnString :=
  1755.        DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1756.         [ PCRPointer^.CIPAddress ] );
  1757.       { Put result in progress and status line }
  1758.       AddProgressText( TheReturnString );
  1759.       ShowProgressErrorText( TheReturnString );
  1760.       { Signal error }
  1761.       Result := False;
  1762.       { leave }
  1763.       exit;
  1764.     end
  1765.     else Result := true; { Signal no problem }
  1766.   end;
  1767. end;
  1768.  
  1769. { This is the FTP components USER login routine }
  1770. function TFTPComponent.LoginUser(
  1771.           PCRPointer : PConnectionsRecord ) : Boolean;
  1772. var TheReturnString : String;  { Internal string holder }
  1773.     TheResult       : Integer; { Internal int holder    }
  1774. begin
  1775.   TheReturnString :=
  1776.    DoCStyleFormat( 'USER %s' ,
  1777.     [ PCRPointer^.CUserName ] );
  1778.   { Put result in progress and status line }
  1779.   AddProgressText( TheReturnString );
  1780.   ShowProgressText( TheReturnString );
  1781.   { Begin login sequence with user name }
  1782.   TheResult := PerformFTPCommand( 'USER %s',
  1783.                                   [ PCRPointer^.CUserName ] );
  1784.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1785.   begin
  1786.     FTPCommandInProgress := false;
  1787.     Result := false;
  1788.     exit;
  1789.   end;
  1790.   repeat
  1791.     TheResult := GetFTPServerResponse( TheReturnString );
  1792.     { Put result in progress and status line }
  1793.     AddProgressText( TheReturnString );
  1794.     ShowProgressText( TheReturnString );
  1795.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1796.   FTPCommandInProgress := false;
  1797.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_CONTINUING )) then
  1798.   begin
  1799.     { Do clever C formatting trick }
  1800.     TheReturnString :=
  1801.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1802.       [ PCRPointer^.CIPAddress ] );
  1803.     { Put result in progress and status line }
  1804.     AddProgressText( TheReturnString );
  1805.     ShowProgressErrorText( TheReturnString );
  1806.     { Signal error }
  1807.     Result := False;
  1808.     { leave }
  1809.     exit;
  1810.   end
  1811.   else Result := true; { Signal no problem }
  1812. end;
  1813.  
  1814. function TFTPComponent.DeleteRemoteDirectory( TheDir : String ) : Boolean;
  1815. var TheReturnString : String;  { Internal string holder }
  1816.     TheResult       : Integer; { Internal int holder    }
  1817. begin
  1818.   TheReturnString := DoCStyleFormat( 'RMD %s' ,
  1819.    [ TheDir ] );
  1820.   { Put result in progress and status line }
  1821.   AddProgressText( TheReturnString );
  1822.   ShowProgressText( TheReturnString );
  1823.   { Send Password sequence }
  1824.   TheResult := PerformFTPCommand( 'RMD %s',
  1825.                                   [ TheDir ] );
  1826.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1827.   begin
  1828.     Result := false;
  1829.     FTPCommandInProgress := false;
  1830.     exit;
  1831.   end;
  1832.   repeat
  1833.     TheResult := GetFTPServerResponse( TheReturnString );
  1834.     { Put result in progress and status line }
  1835.     AddProgressText( TheReturnString );
  1836.     ShowProgressText( TheReturnString );
  1837.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1838.   FTPCommandInProgress := false;
  1839.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1840.   begin
  1841.     { Do clever C formatting trick }
  1842.     TheReturnString :=
  1843.      DoCStyleFormat( 'Delete Directory %s Failed!' ,
  1844.       [ TheDir ] );
  1845.     { Put result in progress and status line }
  1846.     AddProgressText( TheReturnString );
  1847.     ShowProgressErrorText( TheReturnString );
  1848.     { Signal error }
  1849.     Result := False;
  1850.     { leave }
  1851.     exit;
  1852.   end
  1853.   else Result := true; { Signal no problem }
  1854. end;
  1855.  
  1856. function TFTPComponent.CreateRemoteDirectory( TheDir : String ) : Boolean;
  1857. var TheReturnString : String;  { Internal string holder }
  1858.     TheResult       : Integer; { Internal int holder    }
  1859. begin
  1860.   TheReturnString := DoCStyleFormat( 'MKD %s' ,
  1861.     [ TheDir ] );
  1862.   { Put result in progress and status line }
  1863.   AddProgressText( TheReturnString );
  1864.   ShowProgressText( TheReturnString );
  1865.   { Send Password sequence }
  1866.   TheResult := PerformFTPCommand( 'MKD %s',
  1867.                                   [ TheDir ] );
  1868.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1869.   begin
  1870.     Result := false;
  1871.     FTPCommandInProgress := false;
  1872.     exit;
  1873.   end;
  1874.   repeat
  1875.     TheResult := GetFTPServerResponse( TheReturnString );
  1876.     { Put result in progress and status line }
  1877.     AddProgressText( TheReturnString );
  1878.     ShowProgressText( TheReturnString );
  1879.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1880.   FTPCommandInProgress := false;
  1881.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1882.   begin
  1883.     { Do clever C formatting trick }
  1884.     TheReturnString :=
  1885.      DoCStyleFormat( 'Create Directory %s Failed!' ,
  1886.       [ TheDir ] );
  1887.     { Put result in progress and status line }
  1888.     AddProgressText( TheReturnString );
  1889.     ShowProgressErrorText( TheReturnString );
  1890.     { Signal error }
  1891.     Result := False;
  1892.     { leave }
  1893.     exit;
  1894.   end
  1895.   else Result := true; { Signal no problem }
  1896. end;
  1897.  
  1898.  
  1899. function TFTPComponent.DeleteRemoteFile( TheFileName : String ) : Boolean;
  1900. var TheReturnString : String;  { Internal string holder }
  1901.     TheResult       : Integer; { Internal int holder    }
  1902. begin
  1903.   TheReturnString := DoCStyleFormat( 'DELE %s' ,
  1904.     [ TheFileName ] );
  1905.   { Put result in progress and status line }
  1906.   AddProgressText( TheReturnString );
  1907.   ShowProgressText( TheReturnString );
  1908.   { Send Password sequence }
  1909.   TheResult := PerformFTPCommand( 'DELE %s',
  1910.                                   [ TheFileName ] );
  1911.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1912.   begin
  1913.     Result := false;
  1914.     FTPCommandInProgress := false;
  1915.     exit;
  1916.   end;
  1917.   repeat
  1918.     TheResult := GetFTPServerResponse( TheReturnString );
  1919.     { Put result in progress and status line }
  1920.     AddProgressText( TheReturnString );
  1921.     ShowProgressText( TheReturnString );
  1922.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1923.   FTPCommandInProgress := false;
  1924.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1925.   begin
  1926.     { Do clever C formatting trick }
  1927.     TheReturnString :=
  1928.      DoCStyleFormat( 'Delete File %s Failed!' ,
  1929.       [ TheFileName ] );
  1930.     { Put result in progress and status line }
  1931.     AddProgressText( TheReturnString );
  1932.     ShowProgressErrorText( TheReturnString );
  1933.     { Signal error }
  1934.     Result := False;
  1935.     { leave }
  1936.     exit;
  1937.   end
  1938.   else Result := true; { Signal no problem }
  1939. end;
  1940.  
  1941. { This is the FTP components PASSWORD routine }
  1942. function TFTPComponent.SendPassword(
  1943.           PCRPointer : PConnectionsRecord ) : Boolean;
  1944. var TheReturnString : String;  { Internal string holder }
  1945.     TheResult       : Integer; { Internal int holder    }
  1946. begin
  1947.   TheReturnString := 'PASS XXXXXX' + #13#10;
  1948.   { Put result in progress and status line }
  1949.   AddProgressText( TheReturnString );
  1950.   ShowProgressText( TheReturnString );
  1951.   { Send Password sequence }
  1952.   TheResult := PerformFTPCommand( 'PASS %s',
  1953.                                   [ PCRPointer^.CPassword ] );
  1954.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1955.   begin
  1956.     Result := false;
  1957.     FTPCommandInProgress := false;
  1958.     exit;
  1959.   end;
  1960.   repeat
  1961.     TheResult := GetFTPServerResponse( TheReturnString );
  1962.     { Put result in progress and status line }
  1963.     AddProgressText( TheReturnString );
  1964.     ShowProgressText( TheReturnString );
  1965.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1966.   FTPCommandInProgress := false;
  1967.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1968.   begin
  1969.     { Do clever C formatting trick }
  1970.     TheReturnString :=
  1971.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1972.       [ PCRPointer^.CIPAddress ] );
  1973.     { Put result in progress and status line }
  1974.     AddProgressText( TheReturnString );
  1975.     ShowProgressErrorText( TheReturnString );
  1976.     { Signal error }
  1977.     Result := False;
  1978.     { leave }
  1979.     exit;
  1980.   end
  1981.   else Result := true; { Signal no problem }
  1982. end;
  1983.  
  1984. { This is the FTP components CWD routine }
  1985. function TFTPComponent.SetRemoteStartupDirectory(
  1986.           PCRPointer : PConnectionsRecord ) : Boolean;
  1987. var TheReturnString : String;  { Internal string holder }
  1988.     TheResult       : Integer; { Internal int holder    }
  1989. begin
  1990.   Result := true;
  1991.   if PCRPointer^.CStartDir <> '' then
  1992.   begin
  1993.     TheReturnString :=
  1994.      DoCStyleFormat( 'CWD %s' ,
  1995.       [ PCRPointer^.CStartDir ] );
  1996.     { Put result in progress and status line }
  1997.     AddProgressText( TheReturnString );
  1998.     ShowProgressText( TheReturnString );
  1999.     { Send Password sequence }
  2000.     TheResult := PerformFTPCommand( 'CWD %s',
  2001.                                     [ PCRPointer^.CStartDir ] );
  2002.     if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2003.     begin
  2004.       Result := false;
  2005.       FTPCommandInProgress := false;
  2006.       exit;
  2007.     end;
  2008.     repeat
  2009.       TheResult := GetFTPServerResponse( TheReturnString );
  2010.       { Put result in progress and status line }
  2011.       AddProgressText( TheReturnString );
  2012.       ShowProgressText( TheReturnString );
  2013.    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2014.    FTPCommandInProgress := false;
  2015.    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2016.     begin
  2017.       { Do clever C formatting trick }
  2018.       TheReturnString :=
  2019.        DoCStyleFormat( 'CWD to %s Failed!' ,
  2020.         [ PCRPointer^.CStartDir ] );
  2021.       { Put result in progress and status line }
  2022.       AddProgressText( TheReturnString );
  2023.       ShowProgressErrorText( TheReturnString );
  2024.       { Signal error }
  2025.       Result := False;
  2026.       { leave }
  2027.       exit;
  2028.     end
  2029.     else Result := true; { Signal no problem }
  2030.   end;
  2031. end;
  2032.  
  2033. { This is the FTP components CWD routine }
  2034. function TFTPComponent.SetRemoteDirectory( TheDir : String ) : Boolean;
  2035. var TheReturnString : String;  { Internal string holder }
  2036.     TheResult       : Integer; { Internal int holder    }
  2037. begin
  2038.   Result := true;
  2039.   if TheDir <> '' then
  2040.   begin
  2041.     TheReturnString :=
  2042.      DoCStyleFormat( 'CWD %s' ,
  2043.       [ TheDir ] );
  2044.     { Put result in progress and status line }
  2045.     AddProgressText( TheReturnString );
  2046.     ShowProgressText( TheReturnString );
  2047.     { Send Password sequence }
  2048.     TheResult := PerformFTPCommand( 'CWD %s',
  2049.                                     [ TheDir ] );
  2050.     if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2051.     begin
  2052.       Result := false;
  2053.       FTPCommandInProgress := false;
  2054.       exit;
  2055.     end;
  2056.     repeat
  2057.       TheResult := GetFTPServerResponse( TheReturnString );
  2058.       { Put result in progress and status line }
  2059.       AddProgressText( TheReturnString );
  2060.       ShowProgressText( TheReturnString );
  2061.    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2062.    FTPCommandInProgress := false;
  2063.    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2064.     begin
  2065.       { Do clever C formatting trick }
  2066.       TheReturnString :=
  2067.        DoCStyleFormat( 'CWD to %s Failed!' ,
  2068.         [ TheDir ] );
  2069.       { Put result in progress and status line }
  2070.       AddProgressText( TheReturnString );
  2071.       ShowProgressErrorText( TheReturnString );
  2072.       { Signal error }
  2073.       Result := False;
  2074.       { leave }
  2075.       exit;
  2076.     end
  2077.     else Result := true; { Signal no problem }
  2078.   end;
  2079. end;
  2080.  
  2081. { This is the FTP components QUIT routine }
  2082. function TFTPComponent.Disconnect : Boolean;
  2083. var TheReturnString : String;  { Internal string holder }
  2084.     TheResult       : Integer; { Internal int holder    }
  2085. begin
  2086.   TheReturnString :=
  2087.    DoCStyleFormat( 'QUIT' ,
  2088.     [ nil ] );
  2089.   { Put result in progress and status line }
  2090.   AddProgressText( TheReturnString );
  2091.   ShowProgressText( TheReturnString );
  2092.   { Begin login sequence with user name }
  2093.   PerformFTPCommand( 'QUIT', [ nil ] );
  2094.   repeat
  2095.     TheResult := GetFTPServerResponse( TheReturnString );
  2096.     { Put result in progress and status line }
  2097.     AddProgressText( TheReturnString );
  2098.     ShowProgressText( TheReturnString );
  2099.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2100.   FTPCommandInProgress := false;
  2101.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2102.   begin
  2103.     { Do clever C formatting trick }
  2104.     TheReturnString :=
  2105.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2106.       [ nil ] );
  2107.     { Put result in progress and status line }
  2108.     AddProgressText( TheReturnString );
  2109.     ShowProgressErrorText( TheReturnString );
  2110.     { Signal error }
  2111.     Result := False;
  2112.     { leave }
  2113.     exit;
  2114.   end
  2115.   else Result := true; { Signal no problem }
  2116. end;
  2117.  
  2118. { This is the FTP components PWD routine }
  2119. function TFTPComponent.GetRemoteWorkingDirectory( var RemoteDir : String )
  2120.           : Boolean;
  2121. var TheReturnString : String;  { Internal string holder }
  2122.     TheResult       : Integer; { Internal int holder    }
  2123. begin
  2124.   TheReturnString :=
  2125.    DoCStyleFormat( 'PWD' ,
  2126.     [ nil ] );
  2127.   { Put result in progress and status line }
  2128.   AddProgressText( TheReturnString );
  2129.   ShowProgressText( TheReturnString );
  2130.   { Send Password sequence }
  2131.   TheResult := PerformFTPCommand( 'PWD',
  2132.                                   [ nil ] );
  2133.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2134.   begin
  2135.     Result := false;
  2136.     FTPCommandInProgress := false;
  2137.     exit;
  2138.   end;
  2139.   repeat
  2140.     TheResult := GetFTPServerResponse( TheReturnString );
  2141.     { Put result in progress and status line }
  2142.     AddProgressText( TheReturnString );
  2143.     ShowProgressText( TheReturnString );
  2144.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2145.   FTPCommandInProgress := false;
  2146.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2147.   begin
  2148.     { Do clever C formatting trick }
  2149.     TheReturnString :=
  2150.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2151.       [ nil ] );
  2152.     { Put result in progress and status line }
  2153.     AddProgressText( TheReturnString );
  2154.     ShowProgressErrorText( TheReturnString );
  2155.     { Signal error }
  2156.     Result := False;
  2157.     { leave }
  2158.     exit;
  2159.   end
  2160.   else
  2161.   begin
  2162.     Result := true; { Signal no problem }
  2163.     RemoteDir := TheReturnString; { Send back last string on faith }
  2164.   end;
  2165. end;
  2166.  
  2167. { This function sets up a listening port on socekt 2 and handle text replies }
  2168. function TFTPComponent.GetListeningPort : Integer;
  2169. var
  2170.   Address1 ,
  2171.   Address2 ,
  2172.   Address3 ,
  2173.   Address4        : integer; { Address integer conversions }
  2174.   IPAddress       : string;  { IP Address holder           }
  2175.   PortCommand     : string;  { Command holder              }
  2176.   TheResult       : Integer; { Result holder               }
  2177.   TheReturnString : String;  { ditto                       }
  2178. begin
  2179.   { Set up any port on socket 2 }
  2180.   Socket2.PortName := '0';
  2181.   { Listen on a socket }
  2182.   Socket2.CCSockListen;
  2183.   { Get the IP Address of socket 1 and convert it to numbers }
  2184.   IPAddress := Socket1.GetSocketIPAddress( Socket1.TheSocket );
  2185.   Address1 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  2186.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  2187.   Address2 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress) -1 ));
  2188.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  2189.   Address3 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  2190.   Address4 := StrToInt( copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 ));
  2191.   { Turn it into a command and add socket 2 stuff }
  2192.   PortCommand := format( 'PORT %d,%d,%d,%d,%d,%d' ,
  2193.    [ Address1 , Address2 , Address3 , Address4 ,
  2194.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) Shr 8,
  2195.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) and $ff ]);
  2196.   { Put result in progress and status line }
  2197.   AddProgressText( PortCommand + #13#10 );
  2198.   ShowProgressText( PortCommand  + #13#10 );
  2199.   TheResult := PerformFTPCommand( PortCommand , [nil] );
  2200.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2201.   begin
  2202.     Result := TCPIP_STATUS_FATAL_ERROR;
  2203.     FTPCommandInProgress := false;
  2204.     exit;
  2205.   end;
  2206.   repeat
  2207.     TheResult := GetFTPServerResponse( TheReturnString );
  2208.     { Put result in progress and status line }
  2209.     AddProgressText( TheReturnString );
  2210.     ShowProgressText( TheReturnString );
  2211.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2212.   FTPCommandInProgress := false;
  2213.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2214.   begin
  2215.     { Do clever C formatting trick }
  2216.     TheReturnString :=
  2217.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2218.       [ nil ] );
  2219.     { Put result in progress and status line }
  2220.     AddProgressText( TheReturnString );
  2221.     ShowProgressErrorText( TheReturnString );
  2222.     { Signal error }
  2223.     Result := TheResult;
  2224.     { leave }
  2225.     exit;
  2226.   end
  2227.   else
  2228.   begin
  2229.     { Return good result and leave }
  2230.     Result := TheResult;
  2231.     exit;
  2232.   end;
  2233. end;
  2234.  
  2235. { This function returns part of a unit text string }
  2236. function TFTPComponent.GetUNIXTextString( var StringIn : String ) : String;
  2237. var
  2238.   ReturnString : String;
  2239.   TheLength ,
  2240.   Counter_1   : integer;
  2241. begin
  2242.   TheLength := Length( StringIn );
  2243.   if TheLength > 1 then
  2244.   begin
  2245.     for Counter_1 := 1 to TheLength do
  2246.     begin
  2247.       if StringIn[ Counter_1 ] = #10 then
  2248.       begin
  2249.         ReturnString := HolderLine;
  2250.         HolderLine := '';
  2251.         StringIn := Copy( StringIn , Counter_1 + 1 , 255 );
  2252.         Result := ReturnString;
  2253.         exit;
  2254.       end
  2255.       else
  2256.       begin
  2257.         if StringIn[ Counter_1 ] <> #0 then
  2258.         begin
  2259.           if StringIn[ Counter_1 ] <> #13 then
  2260.            HolderLine := HolderLine + StringIn[ Counter_1 ];
  2261.         end
  2262.         else
  2263.         begin
  2264.           Result := '';
  2265.           StringIn := '';
  2266.         end;
  2267.       end;
  2268.     end;
  2269.   end;
  2270.   Result := '';
  2271.   StringIn := '';
  2272. end;
  2273.  
  2274. procedure TFTPComponent.GetFileNameFromUNIXFileName( var TheName : String );
  2275. var Counter_1 : Integer;
  2276.     ResultString : String;
  2277.     Finished : Boolean;
  2278. begin
  2279.   if Pos( 'TOTAL' , Uppercase( TheName )) <> 0 then
  2280.   begin
  2281.     TheName := '';
  2282.     exit;
  2283.   end;
  2284.   Counter_1 := Length( TheName );
  2285.   ResultString := '';
  2286.   Finished := false;
  2287.   while not Finished do
  2288.   begin
  2289.     if TheName[ Counter_1 ] <> ' ' then
  2290.     begin
  2291.       Counter_1 := Counter_1 - 1;
  2292.       if Counter_1 = 0 then
  2293.       begin
  2294.         ResultString := TheName;
  2295.         Finished := true;
  2296.       end;
  2297.     end
  2298.     else
  2299.     begin
  2300.       Finished := true;
  2301.       ResultString := Copy( TheName , Counter_1 + 1 , 255 );
  2302.     end;
  2303.   end;
  2304.   TheName := ResultString;
  2305. end;
  2306.  
  2307. { This is the FTP components get remote directory listing into a list box }
  2308. function TFTPComponent.GetRemoteDirectoryListing( TheListBox : TListBox )
  2309.           : Boolean;
  2310. var TheReturnString : String;  { Internal string holder }
  2311.     TheResult       : Integer; { Internal int holder    }
  2312.     InputString     : String;
  2313.     Through ,
  2314.     Finished        : Boolean;
  2315. begin
  2316.   TheListBox.Clear;
  2317.   TheListbox.Tag := 2;
  2318.   TheListBox.Items.Add('..');
  2319.   Result := true;
  2320.   TheReturnString :=
  2321.    DoCStyleFormat( 'TYPE A' ,
  2322.     [ nil ] );
  2323.   { Put result in progress and status line }
  2324.   AddProgressText( TheReturnString );
  2325.   ShowProgressText( TheReturnString );
  2326.   { Send Password sequence }
  2327.   TheResult := PerformFTPCommand( 'TYPE A',
  2328.                                   [ nil ] );
  2329.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2330.   begin
  2331.     Result := true;
  2332.     FTPCommandInProgress := false;
  2333.     exit;
  2334.   end;
  2335.   repeat
  2336.     TheResult := GetFTPServerResponse( TheReturnString );
  2337.     { Put result in progress and status line }
  2338.     AddProgressText( TheReturnString );
  2339.     ShowProgressText( TheReturnString );
  2340.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2341.   FTPCommandInProgress := false;
  2342.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2343.   begin
  2344.     { Do clever C formatting trick }
  2345.     TheReturnString :=
  2346.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2347.       [ nil ] );
  2348.     { Put result in progress and status line }
  2349.     AddProgressText( TheReturnString );
  2350.     ShowProgressErrorText( TheReturnString );
  2351.     { Signal error }
  2352.     Result := true;
  2353.     { leave }
  2354.     exit;
  2355.   end
  2356.   else
  2357.   begin
  2358.     { Set up socket 2 for listening }
  2359.     Socket2.AsynchMode := False;
  2360.     Socket2.NonAsynchTimeoutValue := 60;
  2361.     { do a listen and send command to server that this is receipt socket }
  2362.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  2363.     begin
  2364.       Socket2.CCSockCancelListen;
  2365.       exit;
  2366.     end;
  2367.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  2368.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  2369.     GetFTPServerResponse( TheReturnString );
  2370.     AddProgressText( TheReturnString );
  2371.     ShowProgressText( TheReturnString );
  2372.     Socket1.NonAsynchTimeoutValue := 30;
  2373.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  2374.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  2375.     begin
  2376.       TheReturnString :=
  2377.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  2378.         [ nil ] );
  2379.       { Put result in progress and status line }
  2380.       AddProgressText( TheReturnString );
  2381.       ShowProgressErrorText( TheReturnString );
  2382.       Socket2.CCSockCancelListen;
  2383.       Result := true;
  2384.       exit;
  2385.     end;
  2386.     Socket2.CCSockAccept;
  2387.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  2388.     begin
  2389.       TheReturnString :=
  2390.        DoCStyleFormat( 'Could not establish receive socket!' ,
  2391.         [ nil ] );
  2392.       { Put result in progress and status line }
  2393.       AddProgressText( TheReturnString );
  2394.       ShowProgressErrorText( TheReturnString );
  2395.       Result := true;
  2396.       exit;
  2397.     end;
  2398.     Through := false;
  2399.     repeat
  2400.       TheReturnString := Socket2.StringData;
  2401.       if Length( TheReturnString ) = 0 then Through := true;
  2402.       if Length( TheReturnString ) > 0 then
  2403.       begin
  2404.         finished := false;
  2405.         while not finished do
  2406.         begin
  2407.           InputString := GetUNIXTextString( TheReturnString );
  2408.           if InputString = '' then Finished := true else
  2409.           begin
  2410.             GetFileNameFromUNIXFileName( InputString);
  2411.             If InputString <> '' then
  2412.             TheListBox.Items.Add( InputString );
  2413.           end;
  2414.         end;
  2415.       end;
  2416.       if GlobalAbortedFlag then
  2417.       begin
  2418.         Socket1.OutOfBand := 'ABOR'+#13#10;
  2419.         repeat
  2420.           TheResult := GetFTPServerResponse( TheReturnString );
  2421.           { Put result in progress and status line }
  2422.           AddProgressText( TheReturnString );
  2423.           ShowProgressText( TheReturnString );
  2424.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2425.         result := true;
  2426.         exit;
  2427.       end;
  2428.     until Through;
  2429.     GetFTPServerResponse( TheReturnString );
  2430.     AddProgressText( TheReturnString );
  2431.     ShowProgressText( TheReturnString );
  2432.     { cancel listening on second socket and close it }
  2433.     Socket2.CCSockCancelListen;
  2434.     Socket2.CCSockClose;
  2435.   end;
  2436.   FTPCommandInProgress := false;
  2437. end;
  2438.  
  2439. { This is the FTP components get remote directory listing into a list box }
  2440. function TFTPComponent.GetRemoteDirectoryListingToMemo : Boolean;
  2441. var TheReturnString : String;  { Internal string holder }
  2442.     TheResult       : Integer; { Internal int holder    }
  2443.     Through         : Boolean;
  2444. begin
  2445.   Result := true;
  2446.   TheReturnString :=
  2447.    DoCStyleFormat( 'TYPE A' ,
  2448.     [ nil ] );
  2449.   { Put result in progress and status line }
  2450.   AddProgressText( TheReturnString );
  2451.   ShowProgressText( TheReturnString );
  2452.   { Send Password sequence }
  2453.   TheResult := PerformFTPCommand( 'TYPE A',
  2454.                                   [ nil ] );
  2455.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2456.   begin
  2457.     Result := true;
  2458.     FTPCommandInProgress := false;
  2459.     exit;
  2460.   end;
  2461.   repeat
  2462.     TheResult := GetFTPServerResponse( TheReturnString );
  2463.     { Put result in progress and status line }
  2464.     AddProgressText( TheReturnString );
  2465.     ShowProgressText( TheReturnString );
  2466.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2467.   FTPCommandInProgress := false;
  2468.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2469.   begin
  2470.     { Do clever C formatting trick }
  2471.     TheReturnString :=
  2472.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2473.       [ nil ] );
  2474.     { Put result in progress and status line }
  2475.     AddProgressText( TheReturnString );
  2476.     ShowProgressErrorText( TheReturnString );
  2477.     { Signal error }
  2478.     Result := true;
  2479.     { leave }
  2480.     exit;
  2481.   end
  2482.   else
  2483.   begin
  2484.     { Set up socket 2 for listening }
  2485.     Socket2.AsynchMode := False;
  2486.     Socket2.NonAsynchTimeoutValue := 30;
  2487.     { do a listen and send command to server that this is receipt socket }
  2488.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  2489.     begin
  2490.       Socket2.CCSockCancelListen;
  2491.       exit;
  2492.     end;
  2493.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  2494.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  2495.     GetFTPServerResponse( TheReturnString );
  2496.     AddProgressText( TheReturnString );
  2497.     ShowProgressText( TheReturnString );
  2498.     Socket1.NonAsynchTimeoutValue := 30;
  2499.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  2500.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  2501.     begin
  2502.       TheReturnString :=
  2503.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  2504.         [ nil ] );
  2505.       { Put result in progress and status line }
  2506.       AddProgressText( TheReturnString );
  2507.       ShowProgressErrorText( TheReturnString );
  2508.       Socket2.CCSockCancelListen;
  2509.       Result := true;
  2510.       exit;
  2511.     end;
  2512.     Socket2.CCSockAccept;
  2513.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  2514.     begin
  2515.       TheReturnString :=
  2516.        DoCStyleFormat( 'Could not establish receive socket!' ,
  2517.         [ nil ] );
  2518.       { Put result in progress and status line }
  2519.       AddProgressText( TheReturnString );
  2520.       ShowProgressErrorText( TheReturnString );
  2521.       Result := true;
  2522.       exit;
  2523.     end;
  2524.     Through := false;
  2525.     repeat
  2526.       TheReturnString := Socket2.StringData;
  2527.       if Length( TheReturnString ) = 0 then Through := true;
  2528.       if Length( TheReturnString ) > 0 then
  2529.       begin
  2530.         { Put result in progress and status line }
  2531.         AddProgressText( TheReturnString );
  2532.         ShowProgressText( TheReturnString );
  2533.       end;
  2534.       if GlobalAbortedFlag then
  2535.       begin
  2536.         Socket1.OutOfBand := 'ABOR'+#13#10;
  2537.         repeat
  2538.           TheResult := GetFTPServerResponse( TheReturnString );
  2539.           { Put result in progress and status line }
  2540.           AddProgressText( TheReturnString );
  2541.           ShowProgressText( TheReturnString );
  2542.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2543.         result := true;
  2544.         exit;
  2545.       end;
  2546.     until Through;
  2547.     GetFTPServerResponse( TheReturnString );
  2548.     AddProgressText( TheReturnString );
  2549.     ShowProgressText( TheReturnString );
  2550.     { cancel listening on second socket and close it }
  2551.     Socket2.CCSockCancelListen;
  2552.     Socket2.CCSockClose;
  2553.   end;
  2554. end;
  2555.  
  2556. { This is the FTP components get local directory listing into a list box }
  2557. function TFTPComponent.GetLocalDirectoryAndListing( var TheString : String;
  2558.                                                         TheListBox : TListBox )
  2559.           : Boolean;
  2560. var TheFLB : TFileListBox;
  2561. begin
  2562.   { Get the working directory }
  2563.   GetDir( 0 , TheString );
  2564.   { Clear incoming LB }
  2565.   TheListBox.Clear;
  2566.   TheListBox.Tag := 2;
  2567.   TheFLB := TFileListBox.Create( Application.MainForm );
  2568.   TheFLB.Visible := false;
  2569.   TheFLB.Parent := Application.MainForm;
  2570.   TheFLB.FileType := [ ftNormal , ftDirectory ];
  2571.   TheFLB.Directory := TheString;
  2572.   TheFLB.Update;
  2573.   TheListBox.Items.Assign( TheFLB.Items );
  2574.   TheFLB.Free;
  2575.   result := true;
  2576. end;
  2577.  
  2578. { This is a clever c-style formatting trick }
  2579. function TFTPComponent.DoCStyleFormat(
  2580.                 TheText      : string;
  2581.           const TheArguments : array of const ) : String;
  2582. begin
  2583.   Result := Format( TheText , TheArguments ) + #13#10;
  2584. end;
  2585.  
  2586. function TFTPComponent.GetQuotedString( TheString : String ) : String;
  2587. var TheIndex     : Integer; { Holder var }
  2588.     ResultString : String;  { ditto      }
  2589. begin
  2590.   { Find out if " present at all }
  2591.   TheIndex := Pos( '"' , TheString );
  2592.   If TheIndex = 0 then
  2593.   begin
  2594.     { If not, return null string and exit }
  2595.     Result := '';
  2596.     exit;
  2597.   end
  2598.   else
  2599.   begin
  2600.     { Get from first " to end of string in holder }
  2601.     ResultString := Copy( TheString , TheIndex + 1 , 255 );
  2602.     { Find position to second " }
  2603.     TheIndex := Pos( '"' , ResultString );
  2604.     { If no ending " then return whole string and leave }
  2605.     if TheIndex = 0 then
  2606.     begin
  2607.       Result := ResultString;
  2608.       exit;
  2609.     end
  2610.     else
  2611.     begin
  2612.       { Get internal text between quotes and exit }
  2613.       ResultString := Copy( ResultString , 1 , TheIndex - 1 );
  2614.       Result := ResultString;
  2615.     end;
  2616.   end;
  2617. end;
  2618.  
  2619. procedure TCCINetCCForm.UpdateGauge( BytesFinished , TotalToHandle : longint );
  2620. var
  2621.   Percentage : longint;
  2622. begin
  2623.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  2624.   if TotalToHandle = 0 then exit;
  2625.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  2626.   Gauge1.Progress := Percentage;
  2627.   Panel1.Caption := '  Status: ' + IntToStr( BytesFinished ) +
  2628.    ' bytes ' + FileNameToXFer + ' (' + IntToStr( Percentage ) + '% Done)';
  2629. end;
  2630.  
  2631. procedure TCCINetCCForm.UpdateUUGauge( BytesFinished , TotalToHandle : longint );
  2632. var
  2633.   Percentage : longint;
  2634. begin
  2635.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  2636.   if TotalToHandle = 0 then exit;
  2637.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  2638.   Gauge1.Progress := Percentage;
  2639.   Panel1.Caption := '  Status: ' + IntToStr( BytesFinished ) +
  2640.    ' bytes UUCode (' + IntToStr( Percentage ) + '% Done)';
  2641.   Panel1.Show;
  2642. end;
  2643.  
  2644. { This procedure actually attempts to connect to the internet at an ftp site }
  2645. function TCCINetCCForm.DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  2646. var TheReturnString : String; { Display results of connection in status lines }
  2647. begin
  2648.   { Create the component }
  2649.   Result := false;
  2650.   { Do busy cursors }
  2651.   SetHGCursors;
  2652.   if not TheFTPComponent.EstablishConnection( PCRPointer ) then
  2653.   begin
  2654.     { Do saved cursors }
  2655.     TheFTPComponent.FTPCommandInProgress := false;
  2656.     TheFTPComponent.Connection_Established := false;
  2657.     SetNormalCursors;
  2658.     exit;
  2659.   end
  2660.   else
  2661.   begin { Connected; continue login process }
  2662.     if not TheFTPComponent.LoginUser( PCRPointer ) then
  2663.     begin
  2664.       { Do saved cursors }
  2665.       TheFTPComponent.FTPCommandInProgress := false;
  2666.       TheFTPComponent.Connection_Established := false;
  2667.       SetNormalCursors;
  2668.       exit;
  2669.     end;
  2670.     if not TheFTPComponent.SendPassword( PCRPointer ) then
  2671.     begin
  2672.       { Do saved cursors }
  2673.       TheFTPComponent.FTPCommandInProgress := false;
  2674.       TheFTPComponent.Connection_Established := false;
  2675.       SetNormalCursors;
  2676.       exit;
  2677.     end;
  2678.     if not TheFTPComponent.SetRemoteStartupDirectory( PCRPointer ) then
  2679.     begin
  2680.       { Do saved cursors }
  2681.       SetNormalCursors;
  2682.       TheFTPComponent.Connection_Established := false;
  2683.       TheFTPComponent.FTPCommandInProgress := false;
  2684.       exit;
  2685.     end;
  2686.     if not TheFTPComponent.GetRemoteWorkingDirectory( TheReturnString ) then
  2687.     begin
  2688.       { Do saved cursors }
  2689.       TheFTPComponent.Connection_Established := false;
  2690.       TheFTPComponent.FTPCommandInProgress := false;
  2691.       SetNormalCursors;
  2692.       exit;
  2693.     end;
  2694.     { Put up remote directory via PWD and strip quotes }
  2695.     Label4.Caption := TheFTPComponent.GetQuotedString( TheReturnString );
  2696.     { Get the listings of directories and exit OK }
  2697.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  2698.     TheFTPComponent.GetLocalDirectoryAndListing( TheReturnString ,
  2699.      Listbox2 );
  2700.     if Label5.Canvas.TextWidth( TheReturnString ) > Label5.Width then
  2701.      TheReturnString := TheFTPComponent.GetShortPathName( TheReturnString );
  2702.     Label5.Caption := TheReturnString;
  2703.     SetNormalCursors;
  2704.     Result := true;
  2705.     EnableFTPMenus;
  2706.     TheFTPComponent.FTPCommandInProgress := false;
  2707.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  2708.   end;
  2709. end;
  2710.  
  2711. { This procedure actually attempts to connect to the internet at an nntp site }
  2712. function TCCINetCCForm.DoNNTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  2713. begin
  2714.   { Create the component }
  2715.   Result := false;
  2716.   { Do busy cursors }
  2717.   SetHGCursors;
  2718.   if not TheNNTPComponent.EstablishConnection( PCRPointer ) then
  2719.   begin
  2720.     { Do saved cursors }
  2721.     TheNNTPComponent.NNTPCommandInProgress := false;
  2722.     TheNNTPComponent.Connection_Established := false;
  2723.     SetNormalCursors;
  2724.     exit;
  2725.   end
  2726.   else
  2727.   begin { Connected; continue login process }
  2728.     SetNormalCursors;
  2729.     Result := true;
  2730.     EnableNNTPMenus;
  2731.     TheNNTPComponent.NNTPCommandInProgress := false;
  2732.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  2733.   end;
  2734. end;
  2735.  
  2736. { This procedure actually attempts to disconnect to the internet at an ftp site}
  2737. procedure TCCINetCCForm.DoFTPDisconnect;
  2738. begin
  2739.   { Call QUIT command }
  2740.   TheFTPComponent.Disconnect;
  2741.   { Kill the socket }
  2742.   TheFTPComponent.Socket1.CCSockClose;
  2743. end;
  2744.  
  2745. { This procedure actually attempts to disconnect to the internet at an ftp site}
  2746. procedure TCCINetCCForm.DoNNTPDisconnect;
  2747. begin
  2748.   { Call QUIT command }
  2749.   TheNNTPComponent.Disconnect;
  2750.   { Kill the socket }
  2751.   TheNNTPComponent.Socket1.CCSockClose;
  2752. end;
  2753.  
  2754. { This procedure reads in the ini file and default path info }
  2755. procedure TCCINetCCForm.ReadIniData;
  2756. begin
  2757.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  2758.   MailPath := TheICCIniFile.ReadString( 'Paths','MailPath','C:\WINDOWS' );
  2759.   NewsPath := TheICCIniFile.ReadString( 'Paths','NewsPath','C:\WINDOWS' );
  2760.   FTPPath := TheICCIniFile.ReadString( 'Paths','FTPPath','C:\WINDOWS' );
  2761.   PasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','PWControl',2 );
  2762.   DefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','DefDL', 3 );
  2763.   TheAnonRedialVector := TheICCIniFile.ReadInteger( 'Vectors','AnonRD', 20 );
  2764.   NewsReadArticlePurgingVector := TheICCIniFile.ReadInteger( 'Vectors','NewsPurge', 1 );
  2765.   NewsPostQueueingVector := TheICCIniFile.ReadInteger( 'Vectors','NewsQueue', 1 );
  2766.   NewsReadArticleDisplayVector := TheICCIniFile.ReadInteger( 'Vectors','NewsRDisp', 1 );
  2767.   NewsUUMIMEVector := TheICCIniFile.ReadInteger( 'Vectors','NewsUUMIME', 2 );
  2768.   NewsInitialUpdateVector := TheICCIniFile.ReadInteger( 'Vectors','NewsInitUD', 1 );
  2769.   EMPasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','EMPWControl', 1 );
  2770.   EMRemoteDeletionVector  := TheICCIniFile.ReadInteger( 'Vectors','EMRemDel', 2 );
  2771.   EMChokeVector           := TheICCIniFile.ReadInteger( 'Vectors','EMChoke', 1 );
  2772.   EMDefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','EMInitUD', 1 );
  2773.   EMQueueVector           := TheICCIniFile.ReadInteger( 'Vectors','EMQueue', 1 );
  2774.   TheICCIniFile.Free;
  2775. end;
  2776.  
  2777. { This procedure writes out default path data to the ini file }
  2778. procedure TCCINetCCForm.WriteIniData;
  2779. begin
  2780.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  2781.   TheICCIniFile.WriteString( 'Paths','MailPath', MailPath );
  2782.   TheICCIniFile.WriteString( 'Paths','NewsPath', NewsPath );
  2783.   TheICCIniFile.WriteString( 'Paths','FTPPath', FTPPath );
  2784.   TheICCIniFile.WriteInteger( 'Vectors','PWControl', PasswordControlVector );
  2785.   TheICCIniFile.WriteInteger( 'Vectors','DefDL', DefaultDownloadVector );
  2786.   TheICCIniFile.WriteInteger( 'Vectors','AnonRD', TheAnonRedialVector );
  2787.   TheICCIniFile.WriteInteger( 'Vectors','NewsPurge',
  2788.    NewsReadArticlePurgingVector );
  2789.   TheICCIniFile.WriteInteger( 'Vectors','NewsQueue', NewsPostQueueingVector );
  2790.   TheICCIniFile.WriteInteger( 'Vectors','NewsRDisp',
  2791.    NewsReadArticleDisplayVector );
  2792.   TheICCIniFile.WriteInteger( 'Vectors','NewsUUMIME', NewsUUMIMEVector );
  2793.   TheICCIniFile.WriteInteger( 'Vectors','NewsInitUD', NewsInitialUpdateVector );
  2794.   TheICCIniFile.WriteInteger( 'Vectors','EMPWControl', EMPasswordControlVector );
  2795.   TheICCIniFile.WriteInteger( 'Vectors','EMRemDel', EMRemoteDeletionVector );
  2796.   TheICCIniFile.WriteInteger( 'Vectors','EMChoke', EMChokeVector );
  2797.   TheICCIniFile.WriteInteger( 'Vectors','EMInitUD', EMDefaultDownloadVector );
  2798.   TheICCIniFile.WriteInteger( 'Vectors','EMQueue', EMQueueVector );
  2799.   TheICCIniFile.Free;
  2800. end;
  2801.  
  2802. { Procedure to load the FTP Site list }
  2803. procedure TCCINetCCForm.LoadFTPSiteFile;
  2804. var TheTCRecord : PConnectionsRecord; { Generic TCR Pointer    }
  2805.     FTPSLName   : String;             { FTP Site List filename }
  2806.     Counter_1   : Integer;            { Loop counter           }
  2807. begin
  2808.   { Create the sites list list }
  2809.   TheFTPSiteList := TList.Create;
  2810.   { Set up the FTP sites list file name }
  2811.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  2812.   { If the FTP Site List exists load it in }
  2813.   if FileExists( FTPSLName ) then
  2814.   begin
  2815.     { set up the file and open it }
  2816.     AssignFile( TheFTPSiteFile , FTPSLName );
  2817.     Reset( TheFTPSiteFile );
  2818.     { read in the records }
  2819.     for Counter_1 := 0 to FileSize( TheFTPSiteFile ) - 1 do
  2820.     begin
  2821.       { Create the TCRecord }
  2822.       New( TheTCRecord );
  2823.       { Read in the data record }
  2824.       Seek( TheFTPSiteFile , Counter_1 );
  2825.       Read( TheFTPSiteFile , TheTCRecord^ );
  2826.       { Add the record to the list }
  2827.       TheFTPSiteList.Add( TheTCRecord );
  2828.     end;
  2829.     { close the file }
  2830.     CloseFile( TheFTPSiteFile );
  2831.   end
  2832.   else
  2833.   { Otherwise create a default one with a few anonymous sites }
  2834.   begin
  2835.     { create new record }
  2836.     New( TheTCRecord );
  2837.     { fill in its info }
  2838.     with TheTCRecord^ do
  2839.     begin
  2840.       CProfile   := 'Winsite Windows Archive';
  2841.       CIPAddress := 'ftp.winsite.com';
  2842.       CUserName  := 'anonymous';
  2843.       CPassword  := 'guest@nowhere.com';
  2844.       CStartDir  := '/pub';
  2845.     end;
  2846.     { add it to the list }
  2847.     { do it three more times }
  2848.     TheFTPSiteList.Add( TheTCRecord );
  2849.     New( TheTCRecord );
  2850.     with TheTCRecord^ do
  2851.     begin
  2852.       CProfile   := 'Digital Equipment Corp';
  2853.       CIPAddress := 'gatekeeper.dec.com';
  2854.       CUserName  := 'anonymous';
  2855.       CPassword  := 'guest@nowhere.com';
  2856.       CStartDir  := '/pub';
  2857.     end;
  2858.     TheFTPSiteList.Add( TheTCRecord );
  2859.     New( TheTCRecord );
  2860.     with TheTCRecord^ do
  2861.     begin
  2862.       CProfile   := 'Microsoft FTP Site';
  2863.       CIPAddress := 'ftp.microsoft.com';
  2864.       CUserName  := 'anonymous';
  2865.       CPassword  := 'guest@nowhere.com';
  2866.       CStartDir  := '/pub';
  2867.     end;
  2868.     TheFTPSiteList.Add( TheTCRecord );
  2869.     New( TheTCRecord );
  2870.     with TheTCRecord^ do
  2871.     begin
  2872.       CProfile   := 'Oakland MSDOS Archive';
  2873.       CIPAddress := 'oak.oakland.edu';
  2874.       CUserName  := 'anonymous';
  2875.       CPassword  := 'guest@nowhere.com';
  2876.       CStartDir  := '/pub';
  2877.     end;
  2878.     TheFTPSiteList.Add( TheTCRecord );
  2879.     { create the file and write out the data, then close it }
  2880.     AssignFile( TheFTPSiteFile , FTPSLName );
  2881.     Rewrite( TheFTPSiteFile );
  2882.     for Counter_1 := 0 to 3 do
  2883.     begin
  2884.       TheTCRecord :=
  2885.        PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  2886.       Seek( TheFTPSiteFile , Counter_1 );
  2887.       Write( TheFTPSiteFile , TheTCRecord^ );
  2888.     end;
  2889.     CloseFile( TheFTPSiteFile );
  2890.   end;
  2891.   { Create the working copy for use to make safe changes in info dlg }
  2892.   TheWorkingFTPSL := TList.Create;
  2893.   For Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2894.   begin
  2895.     New( TheTCRecord );
  2896.     TheTCRecord^ := PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] )^;
  2897.     TheWorkingFTPSL.Add( TheTCRecord );
  2898.   end;
  2899. end;
  2900.  
  2901. { Procedure to load the NNTP Site list }
  2902. procedure TCCINetCCForm.LoadNNTPSiteFile;
  2903. var TheNGRecord : PConnectionsRecord; { Generic TCR Pointer    }
  2904.     NNTPSLName  : String;             { NNTP Site List filename }
  2905.     Counter_1   : Integer;            { Loop counter           }
  2906. begin
  2907.   { Create the sites list list }
  2908.   TheNewsServerList := TList.Create;
  2909.   { Set up the FTP sites list file name }
  2910.   NNTPSLName := NewsPath + '\NNTPSITE.TCR';
  2911.   { If the FTP Site List exists load it in }
  2912.   if FileExists( NNTPSLName ) then
  2913.   begin
  2914.     { set up the file and open it }
  2915.     AssignFile( TheNewsServerFile , NNTPSLName );
  2916.     Reset( TheNewsServerFile );
  2917.     { read in the records }
  2918.     for Counter_1 := 0 to FileSize( TheNewsServerFile ) - 1 do
  2919.     begin
  2920.       { Create the TCRecord }
  2921.       New( TheNGRecord );
  2922.       { Read in the data record }
  2923.       Seek( TheNewsServerFile , Counter_1 );
  2924.       Read( TheNewsServerFile , TheNGRecord^ );
  2925.       { Add the record to the list }
  2926.       TheNewsServerList.Add( TheNGRecord );
  2927.     end;
  2928.     { close the file }
  2929.     CloseFile( TheNewsServerFile );
  2930.   end
  2931.   else
  2932.   { Otherwise create a default one with a generic news site (?) }
  2933.   begin
  2934.     { create new record }
  2935.     New( TheNGRecord );
  2936.     { fill in its info }
  2937.     with TheNGRecord^ do
  2938.     begin
  2939.       CProfile   := 'My News Server';
  2940.       CIPAddress := 'news.myprovider.com';
  2941.       CUserName  := '';
  2942.       CPassword  := '';
  2943.       CStartDir  := '';
  2944.     end;
  2945.     { add it to the list }
  2946.     { do it three more times }
  2947.     TheNewsServerList.Add( TheNGRecord );
  2948.     { create the file and write out the data, then close it }
  2949.     AssignFile( TheNewsServerFile , NNTPSLName );
  2950.     Rewrite( TheNewsServerFile );
  2951.     TheNGRecord :=
  2952.        PConnectionsRecord( TheNewsServerList.Items[ 0 ] );
  2953.       Seek( TheNewsServerFile , 0 );
  2954.       Write( TheNewsServerFile , TheNGRecord^ );
  2955.     CloseFile( TheNewsServerFile );
  2956.   end;
  2957.   TheWorkingNSSL := TList.Create;
  2958.   For Counter_1 := 0 to TheNewsServerList.Count - 1 do
  2959.   begin
  2960.     New( TheNGRecord );
  2961.     TheNGRecord^ := PConnectionsRecord( TheNewsServerList.Items[ Counter_1 ] )^;
  2962.     TheWorkingNSSL.Add( TheNGRecord );
  2963.   end;
  2964. end;
  2965.  
  2966. { This procedure saves off the FTP Site List }
  2967. procedure TCCINetCCForm.SaveFTPSiteFile;
  2968. var TheTCRecord : PConnectionsRecord; { The TC Record pointer  }
  2969.     FTPSLName   : String;             { FTP Site List filename }
  2970.     Counter_1   : Integer;            { Loop counter           }
  2971. begin
  2972.   { Set up the file name }
  2973.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  2974.   { Assign the file }
  2975.   AssignFile( TheFTPSiteFile , FTPSLName );
  2976.   { Rewrite it }
  2977.   Rewrite( TheFTPSiteFile );
  2978.   { run the list through the procedure }
  2979.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2980.   begin
  2981.     { get the record from the list }
  2982.     TheTCRecord :=
  2983.      PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  2984.     { Do the seek/write }
  2985.     Seek( TheFTPSiteFile , Counter_1 );
  2986.     Write( TheFTPSiteFile , TheTCRecord^ );
  2987.     { free the record }
  2988.     Dispose( TheTCRecord );
  2989.   end;
  2990.   { Close the file }
  2991.   CloseFile( TheFTPSiteFile );
  2992.   { Free the list pointers }
  2993.   TheFTPSiteList.Free;
  2994.   TheWorkingFTPSL.Free;
  2995. end;
  2996.  
  2997. { This procedure saves off the FTP Site List }
  2998. procedure TCCINetCCForm.SaveNNTPSiteFile;
  2999. var TheNGRecord : PConnectionsRecord; { The TC Record pointer   }
  3000.     NNTPSLName   : String;            { NNTP Site List filename }
  3001.     Counter_1   : Integer;            { Loop counter           }
  3002. begin
  3003.   { Set up the file name }
  3004.   NNTPSLName := NewsPath + '\NNTPSITE.TCR';
  3005.   { Assign the file }
  3006.   AssignFile( TheNewsServerFile , NNTPSLName );
  3007.   { Rewrite it }
  3008.   Rewrite( TheNewsServerFile );
  3009.   { run the list through the procedure }
  3010.   for Counter_1 := 0 to TheNewsServerList.Count - 1 do
  3011.   begin
  3012.     { get the record from the list }
  3013.     TheNGRecord :=
  3014.      PConnectionsRecord( TheNewsServerList.Items[ Counter_1 ] );
  3015.     { Do the seek/write }
  3016.     Seek( TheNewsServerFile , Counter_1 );
  3017.     Write( TheNewsServerFile , TheNGRecord^ );
  3018.     { free the record }
  3019.     Dispose( TheNGRecord );
  3020.   end;
  3021.   { Close the file }
  3022.   CloseFile( TheNewsServerFile );
  3023.   { Free the list pointers }
  3024.   TheNewsServerList.Free;
  3025.   TheWorkingNSSL.Free;
  3026. end;
  3027.  
  3028. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3029. procedure TCCINetCCForm.SetupFTPSiteLists;
  3030. var Counter_1  : Integer;            { Loop counter        }
  3031. begin
  3032.   { Set up display for main form }
  3033.   CCINetCCForm.Tag := 2;
  3034.   CCINetCCForm.Caption := 'CC Internet Command Center -- FTP Mode';
  3035.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  3036.   CCINetCCForm.FTP1.Enabled := false;
  3037.   CCINetCCForm.FTP2.Enabled := true;
  3038.   CCINetCCForm.Label1.Caption := 'FTP Site:';
  3039.   CCINetCCForm.Button1.Caption := 'Connect';
  3040.   CCINetCCForm.Label4.Caption := 'Local Dir';
  3041.   CCINetCCForm.Label5.Caption := 'Remote Dir';
  3042.   { Set tag for FTP stuff }
  3043.   CCICInfoDlg.Tag := 2;
  3044.   { set up caption of main label }
  3045.   CCICInfoDlg.Label2.Caption := 'FTP Sites';
  3046.   { hide outline panel }
  3047.   CCICInfoDlg.Panel6.Visible := false;
  3048.   { clear the list box }
  3049.   CCICInfoDlg.ListBox2.Clear;
  3050.   CCINetCCForm.ComboBox1.Clear;
  3051.   { add profile strings to the list box }
  3052.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  3053.   begin
  3054.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  3055.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  3056.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  3057.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  3058.   end;
  3059.   { Set up caption of special button }
  3060.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  3061.   { Start with top record }
  3062.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  3063.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  3064.   { put in data from top record and reset captions }
  3065.   with PConnectionsRecord( TheFTPSiteList.Items[ 0 ] )^ do
  3066.   begin
  3067.     with CCICInfoDlg do
  3068.     begin
  3069.       Edit1.Text := CProfile;
  3070.       Panel2.Caption := '            Name:';
  3071.       Edit2.Text := CIPAddress;
  3072.       Panel3.Caption := '     IP Address:';
  3073.       Edit3.Text := CUserName;
  3074.       Panel5.Caption := '    User Name:';
  3075.       case PasswordControlVector of
  3076.         1 : Edit4.Text := CPassword;
  3077.         2 : Edit4.Text := '**********';
  3078.       end;
  3079.       Panel8.Caption := '      Password:';
  3080.       Edit5.Text := CStartDir;
  3081.       Panel9.Caption := '    Starting Dir:';
  3082.     end;
  3083.   end;
  3084. end;
  3085.  
  3086. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3087. procedure TCCINetCCForm.SetupNNTPSiteLists;
  3088. begin
  3089.   { Set up display for main form }
  3090.   CCINetCCForm.Tag := 4; { Usenet News Tag }
  3091.   CCINetCCForm.Caption := 'CC Internet Command Center -- Usenet News Mode';
  3092.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  3093.   CCINetCCForm.FTP1.Enabled := true;
  3094.   CCINetCCForm.FTP2.Enabled := false;
  3095.   CCINetCCForm.UsenetNws1.Enabled := false;
  3096.   CCINetCCForm.News1.Enabled := true;
  3097.   CCINetCCForm.Label1.Caption := 'NNTP Server:';
  3098.   CCINetCCForm.Button1.Caption := 'Connect';
  3099.   CCINetCCForm.Label4.Caption := 'SubScribed Groups';
  3100.   CCINetCCForm.Label5.Caption := 'Unread Articles';
  3101.   { Create the working copy for use to make safe changes in info dlg }
  3102. end;
  3103.  
  3104. { This method saves off the Newsgroup and Article Lists }
  3105. procedure TCCINetCCForm.SaveNNTPNewsGroupLists;
  3106. var TheNGRecord : PNewsGroupRecord; { Generic NGR Pointer       }
  3107.     TheNGARecord : PNewsGroupArticleRecord; {  }
  3108.     WorkingList : TList;
  3109.     Counter_1 ,
  3110.     Counter_2   : Integer;          { Loop counter              }
  3111.     NNTPNGLName ,                   { NewsGroup Articles fname  }
  3112.     NNTPARName  : String;           { NNTP NewsRC filename      }
  3113. begin
  3114.   { Abort if no server to select }
  3115.   if ComboBox1.ItemIndex = -1 then exit;
  3116.   { Get number of server in list }
  3117.   WhichServer := ComboBox1.ItemIndex;
  3118.   { Set up the FTP sites list file name }
  3119.   NNTPNGLName := NewsPath + '\NEWSRC ' + IntToStr( WhichServer ) + '.NRC';
  3120.   { If the FTP Site List exists load it in }
  3121.   { set up the file and open it }
  3122.   AssignFile( TheNewsRCFile , NNTPNGLName );
  3123.   ReWrite( TheNewsRCFile );
  3124.   { read in the records }
  3125.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3126.   begin
  3127.     { Create the TCRecord }
  3128.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  3129.     { Read in the data record }
  3130.     Seek( TheNewsRCFile , Counter_1 );
  3131.     Write( TheNewsRCFile , TheNGRecord^ );
  3132.     { Add the record to the list }
  3133.     WorkingList := TList( TheNGRecord^.GLTag );
  3134.     if WorkingList.Count > 0 then
  3135.     begin
  3136.       NNTPARName := TheNGRecord^.GFileName;
  3137.       TheNGArticlesList := TList.Create;
  3138.       AssignFile( TheNewsArticleFile , NewsPath + '\' + NNTPARName );
  3139.       ReWrite( TheNewsArticleFile );
  3140.       for Counter_2 := 0 to WorkingList.Count - 1 do
  3141.       begin
  3142.         TheNGARecord :=
  3143.          PNewsGroupArticleRecord( WorkingList.Items[ Counter_2 ] );
  3144.         Seek( TheNewsArticleFile , Counter_2 );
  3145.         Write( TheNewsArticleFile , TheNGARecord^ );
  3146.         Dispose( TheNGARecord );
  3147.       end;
  3148.       CloseFile( TheNewsArticleFile );
  3149.     end;
  3150.     WorkingList.Free;
  3151.     Dispose( TheNGRecord );
  3152.   end;
  3153.   { close the file }
  3154.   CloseFile( TheNewsRCFile );
  3155.   { Free the list itself }
  3156.   TheNewsRCList.Free;
  3157. end;
  3158.  
  3159. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3160. procedure TCCINetCCForm.SetupNNTPNewsGroupLists;
  3161. var TheNGRecord : PNewsGroupRecord; { Generic NGR Pointer       }
  3162.     TheNGARecord : PNewsGroupArticleRecord; {  }
  3163.     Counter_1 ,
  3164.     Counter_2   : Integer;          { Loop counter              }
  3165.     NNTPNGLName ,                   { NewsGroup Articles fname  }
  3166.     NNTPARName  : String;           { NNTP NewsRC filename      }
  3167. begin
  3168.   { Abort if no server to select }
  3169.   if ComboBox1.ItemIndex = -1 then exit;
  3170.   { Get number of server in list }
  3171.   WhichServer := ComboBox1.ItemIndex;
  3172.   { Create the sites list list }
  3173.   TheNewsRCList := TList.Create;
  3174.   { Set up the FTP sites list file name }
  3175.   NNTPNGLName := NewsPath + '\NEWSRC ' + IntToStr( WhichServer ) + '.NRC';
  3176.   { If the FTP Site List exists load it in }
  3177.   if FileExists( NNTPNGLName ) then
  3178.   begin
  3179.     { set up the file and open it }
  3180.     AssignFile( TheNewsRCFile , NNTPNGLName );
  3181.     Reset( TheNewsRCFile );
  3182.     { read in the records }
  3183.     for Counter_1 := 0 to FileSize( TheNewsRCFile ) - 1 do
  3184.     begin
  3185.       { Create the TCRecord }
  3186.       New( TheNGRecord );
  3187.       { Read in the data record }
  3188.       Seek( TheNewsRCFile , Counter_1 );
  3189.       Read( TheNewsRCFile , TheNGRecord^ );
  3190.       { Add the record to the list }
  3191.       TheNewsRCList.Add( TheNGRecord );
  3192.     end;
  3193.     { close the file }
  3194.     CloseFile( TheNewsRCFile );
  3195.   end
  3196.   else
  3197.   { Otherwise create a default one with 3 delphi newsgroups }
  3198.   begin
  3199.     { create new record }
  3200.     New( TheNGRecord );
  3201.     { fill in its info }
  3202.     with TheNGRecord^ do
  3203.     begin
  3204.       GName                := 'Delphi Comps';
  3205.       GRealName            := 'comp.lang.pascal.delphi.components';
  3206.       GLowest              := 0;
  3207.       GHighest             := 0;
  3208.       GPostable            := true;
  3209.       GSubscribed          := true;
  3210.       GTotalArticles       := 0;
  3211.       GTotalAvailable      := 0;
  3212.       GLowestAvailable     := 0;
  3213.       GHighestAvailable    := 0;
  3214.       GTotalUnReadArticles := 0;
  3215.       GIDNumber            := 1;
  3216.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G1.NGR';
  3217.       GLTag                := 0;
  3218.     end;
  3219.     { add it to the list }
  3220.     TheNewsRCList.Add( TheNGRecord );
  3221.     { create new record }
  3222.     New( TheNGRecord );
  3223.     { fill in its info }
  3224.     with TheNGRecord^ do
  3225.     begin
  3226.       GName                := 'Delphi DB';
  3227.       GRealName            := 'comp.lang.pascal.delphi.databases';
  3228.       GLowest              := 0;
  3229.       GHighest             := 0;
  3230.       GPostable            := true;
  3231.       GSubscribed          := true;
  3232.       GTotalArticles       := 0;
  3233.       GTotalAvailable      := 0;
  3234.       GLowestAvailable     := 0;
  3235.       GHighestAvailable    := 0;
  3236.       GTotalUnReadArticles := 0;
  3237.       GIDNumber            := 2;
  3238.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G2.NGR';
  3239.       GLTag                := 0;
  3240.     end;
  3241.     { add it to the list }
  3242.     TheNewsRCList.Add( TheNGRecord );
  3243.     { create new record }
  3244.     New( TheNGRecord );
  3245.     { fill in its info }
  3246.     with TheNGRecord^ do
  3247.     begin
  3248.       GName                := 'Delphi Misc';
  3249.       GRealName            := 'comp.lang.pascal.delphi.misc';
  3250.       GLowest              := 0;
  3251.       GHighest             := 0;
  3252.       GPostable            := true;
  3253.       GSubscribed          := true;
  3254.       GTotalArticles       := 0;
  3255.       GTotalAvailable      := 0;
  3256.       GLowestAvailable     := 0;
  3257.       GHighestAvailable    := 0;
  3258.       GTotalUnReadArticles := 0;
  3259.       GIDNumber            := 3;
  3260.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G3.NGR';
  3261.       GLTag                := 0;
  3262.     end;
  3263.     { add it to the list }
  3264.     TheNewsRCList.Add( TheNGRecord );
  3265.     { create the file and write out the data, then close it }
  3266.     AssignFile( TheNewsRCFile , NNTPNGLName );
  3267.     Rewrite( TheNewsRCFile );
  3268.     for Counter_1 := 0 to 2 do
  3269.     begin
  3270.       TheNGRecord :=
  3271.        PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  3272.       Seek( TheNewsRCFile , Counter_1 );
  3273.       Write( TheNewsRCFile , TheNGRecord^ );
  3274.     end;
  3275.     CloseFile( TheNewsRCFile );
  3276.   end;
  3277.   { Load in Articles Records and create storage lists }
  3278.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3279.   begin
  3280.     NNTPARName := PNewsGroupRecord(
  3281.      TheNewsRCList.Items[ Counter_1 ] )^.GFileName;
  3282.     if FileExists( NewsPath + '\' + NNTPARName ) then
  3283.     begin
  3284.       TheNGArticlesList := TList.Create;
  3285.       AssignFile( TheNewsArticleFile , NewsPath + '\' + NNTPARName );
  3286.       Reset( TheNewsArticleFile );
  3287.       for Counter_2 := 0 to FileSize( TheNewsArticleFile ) - 1 do
  3288.       begin
  3289.         New( TheNGARecord );
  3290.         Seek( TheNewsArticleFile , Counter_2 );
  3291.         Read( TheNewsArticleFile , TheNGARecord^ );
  3292.         TheNGArticlesList.Add( TheNGARecord );
  3293.       end;
  3294.       CloseFile( TheNewsArticleFile );
  3295.       PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^.GLTag :=
  3296.        Longint( TheNGArticlesList );
  3297.     end
  3298.     else
  3299.     begin
  3300.       TheNGArticlesList := TList.Create;
  3301.       PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^.GLTag :=
  3302.        Longint( TheNGArticlesList );
  3303.     end;
  3304.   end;
  3305.   { Create working Newsgroup list for later }
  3306.   TheWorkingNRCSL := TList.Create;
  3307.   For Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3308.   begin
  3309.     New( TheNGRecord );
  3310.     TheNGRecord^ := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^;
  3311.     TheWorkingNRCSL.Add( TheNGRecord );
  3312.   end;
  3313. end;
  3314.  
  3315. { This procedure populates LB2 with article subjects for any }
  3316. { available articles for a given newsgroup.                  }
  3317. procedure TCCINetCCForm.PopulateLB2WithArticleHeaders;
  3318. var Counter_1    : Integer;
  3319.     TheNGARecord : PNewsGroupArticleRecord;
  3320.     TempString   : String;
  3321. begin
  3322.   { Clear target list box }
  3323.   ListBox2.Clear;
  3324.   for Counter_1 := 0 to TheNGArticlesList.Count - 1 do
  3325.   begin
  3326.     TheNGARecord :=
  3327.      PNewsGroupArticleRecord( TheNGArticlesList.Items[ Counter_1 ] );
  3328.     TempString := '    [' + IntToStr( Counter_1 ) + '] ' +
  3329.      TheNGARecord^.NGASubject;
  3330.     if TheNGARecord^.NGADownloaded then TempString[ 1 ] :=
  3331.      'D';
  3332.     if TheNGARecord^.NGARead then TempString[ 3 ] := 'R';
  3333.     if TheNGARecord^.NGAPosted then TempString[ 3 ] := 'S';
  3334.     ListBox2.Items.Add( TempString );
  3335.   end;
  3336. end;
  3337.  
  3338. { This procedure swaps in the list of subscribed newsgroups to LB1 }
  3339. { and calls another procedure to populate LB2 with any available   }
  3340. { articles for the newsgroup.                                      }
  3341. procedure TCCINetCCForm.SetupNewsGroupListboxes;
  3342. var Counter_1   : Integer;
  3343.     TempString  : String;
  3344.     TheNGRecord : PNewsGroupRecord;
  3345. begin
  3346.   ListBox1.Clear;
  3347.   ListBox1.Tag := 5;
  3348.   ListBox2.Tag := 5;
  3349.   Label4.Caption := 'NewsGroups';
  3350.   Label5.Caption := 'Articles';
  3351.   if TheNewsRCList.Count = 0 then
  3352.   begin
  3353.     ListBox2.Clear;
  3354.     exit;
  3355.   end;
  3356.   ComboBox1.Clear;
  3357.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3358.   begin
  3359.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  3360.     TempString := TheNGRecord^.GName;
  3361.     ComboBox1.Items.Add( TheNGRecord^.GRealName );
  3362.     if TheNGRecord^.GSubscribed then
  3363.      TempString := '[S] ' + TempString else TempString := '[U] ' + TempString;
  3364.     TempString := TempString + '{' + IntToStr( TheNGRecord^.GTotalNew ) + '}';
  3365.     ListBox1.Items.Add( TempString );
  3366.   end;
  3367.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ 0 ] );
  3368.   TheNGArticlesList := TList( TheNGRecord^.GLTag );
  3369.   PopulateLB2WithArticleHeaders;
  3370.   Label1.Caption := 'NewsGroup:';
  3371.   ComboBox1.ItemIndex := 0;
  3372.   Button1.Caption := 'DL Article(s)';
  3373.   Tag := 5; { Set download vector }
  3374. end;
  3375.  
  3376. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3377. procedure TCCINetCCForm.SetupNNTPServersInfoDisplay;
  3378. var Counter_1  : Integer;            { Loop counter        }
  3379. begin
  3380.   { Set tag for NNTP stuff }
  3381.   CCICInfoDlg.Tag := 4; { Usenet News Tag -- servers }
  3382.   { set up caption of main label }
  3383.   CCICInfoDlg.Label2.Caption := 'News Server Sites';
  3384.   { hide outline panel }
  3385.   CCICInfoDlg.Panel6.Visible := false;
  3386.   CCICInfoDlg.Panel5.Visible := false;
  3387.   CCICInfoDlg.Panel8.Visible := false;
  3388.   CCICInfoDlg.Panel9.Visible := false;
  3389.   { clear the list box }
  3390.   CCICInfoDlg.ListBox2.Clear;
  3391.   CCINetCCForm.ComboBox1.Clear;
  3392.   { add profile strings to the list box }
  3393.   for Counter_1 := 0 to TheNewsServerList.Count - 1 do
  3394.   begin
  3395.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  3396.      TheNewsServerList.Items[ Counter_1 ] )^.CProfile );
  3397.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  3398.      TheNewsServerList.Items[ Counter_1 ] )^.CProfile );
  3399.   end;
  3400.   { Set up caption of special button }
  3401.   CCICInfoDlg.Button1.Visible := false;
  3402.   { Start with top record }
  3403.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  3404.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  3405.   { put in data from top record and reset captions }
  3406.   with PConnectionsRecord( TheNewsServerList.Items[ 0 ] )^ do
  3407.   begin
  3408.     with CCICInfoDlg do
  3409.     begin
  3410.       Edit1.Text := CProfile;
  3411.       Panel2.Caption := '            Name:';
  3412.       Edit2.Text := CIPAddress;
  3413.       Panel3.Caption := '     IP Address:';
  3414.     end;
  3415.   end;
  3416. end;
  3417.  
  3418. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3419. procedure TCCINetCCForm.SetupNNTPNewsGroupsInfoDisplay;
  3420. var Counter_1  : Integer;            { Loop counter        }
  3421.     WorkingFileName : String;
  3422.     TheWorkingSL : TStringList;
  3423. begin
  3424.   { Set tag for NNTP stuff }
  3425.   CCICInfoDlg.Tag := 5; { Usenet News Tag -- newsgroups }
  3426.   { set up caption of main label }
  3427.   CCICInfoDlg.Label2.Caption := 'Active NewsGroups';
  3428.   { hide outline panel }
  3429.   CCICInfoDlg.Panel5.Visible := true;
  3430.   CCICInfoDlg.Panel6.Visible := true;
  3431.   CCICInfoDlg.Panel6.Height := 224;
  3432.   CCICInfoDlg.Panel6.Top := 120;
  3433.   CCICInfoDlg.Label1.Caption := 'Available NewsGroups';
  3434.   CCICInfoDlg.Panel8.Visible := false;
  3435.   CCICInfoDlg.Panel9.Visible := false;
  3436.   { clear the list box }
  3437.   CCICInfoDlg.ListBox2.Clear;
  3438.   { add profile strings to the list box }
  3439.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3440.   begin
  3441.     CCICInfoDlg.ListBox2.Items.Add( PNewsGroupRecord(
  3442.      TheNewsRCList.Items[ Counter_1 ] )^.GName );
  3443.   end;
  3444.   { Set up caption of special button }
  3445.   CCICInfoDlg.Button1.Visible := true;
  3446.   CCICInfoDlg.Button1.Caption := 'Toggle Subscription';
  3447.   { Start with top record }
  3448.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  3449.   { put in data from top record and reset captions }
  3450.   with PNewsGroupRecord( TheNewsRCList.Items[ 0 ] )^ do
  3451.   begin
  3452.     with CCICInfoDlg do
  3453.     begin
  3454.       Edit1.Text := GName;
  3455.       Panel2.Caption := 'NG Name:';
  3456.       Edit2.Text := GRealName;
  3457.       Panel3.Caption := 'NG Real Name:';
  3458.       if GSubscribed then
  3459.       Edit3.Text := 'Subscribed' else Edit3.Text := 'UnSubscribed';
  3460.       Panel5.Caption := 'Status:';
  3461.     end;
  3462.   end;
  3463.   if newsgroupListloaded then exit;
  3464.   WorkingFileName := NewsPath + '\NEWSGRP.TXT';
  3465.   if FileExists( WorkingFileName ) then
  3466.   begin
  3467.     if MessageDlg( 'Load News Groups File? (Long operation...)',
  3468.      mtConfirmation,mbYesNoCancel,0) = mrYes then
  3469.     begin
  3470.       CCICInfoDlg.ListBox1.Clear;
  3471.       TheWorkingSL := TStringList.Create;
  3472.       try
  3473.         TheWorkingSL.LoadFromFile( WorkingFileName );
  3474.         CCICInfoDlg.ListBox1.Items.Assign( TheWorkingSL );
  3475.       except
  3476.         MessageDlg( 'News Group List Too Large! Use WordPad/Write to view ' +
  3477.                       NewsPath + '\NEWGRP.TXT' , mtInformation,[mbOK],0);
  3478.         TheWorkingSL.Free;
  3479.         NewsgroupListLoaded := false;
  3480.         exit;
  3481.       end;
  3482.       TheWorkingSL.Free;
  3483.       NewsgroupListLoaded := true;
  3484.     end;
  3485.   end;
  3486. end;
  3487.  
  3488. { This procedure scans a line of UNIX-style text for #10's and }
  3489. { outputs them as lines to the memo. It stops at #0.           }
  3490. procedure TCCINetCCForm.AddNullTermTextToMemo( TheTextToAdd   : String;
  3491.                                  TheMemoToAddTo : TMemo   );
  3492. var
  3493.   TextLength ,            { Total chars to output         }
  3494.   Counter_1    : integer; { Loop Index                    }
  3495. begin
  3496.   { Make the target memo visible just in case }
  3497.   TheMemoToAddTo.Visible := true;
  3498.   { Find total chars to output }
  3499.   TextLength := Length( TheTextToAdd );
  3500.   { If none then leave }
  3501.   if TextLength = 0 then exit;
  3502.   { Loop along the string }
  3503.   for Counter_1 := 1 to TextLength do
  3504.   begin
  3505.     { If hit ASCII 10 then assume end of line and output }
  3506.     if TheTextToAdd[ Counter_1 ] = #10 then
  3507.     begin
  3508.       { Use a try loop incase memo fills up }
  3509.       try
  3510.         { Add the line }
  3511.         TheMemoToAddTo.Lines.Add( TheLine );
  3512.       except
  3513.         { If memo fills up }
  3514.         on EOutOfResources do
  3515.         begin
  3516.           { Clear the old data }
  3517.           TheMemoToAddTo.Clear;
  3518.           { Output the new }
  3519.           TheMemoToAddTo.Lines.Add( TheLine );
  3520.         end;
  3521.       end;
  3522.       { clear the output buffer }
  3523.       TheLine := '';
  3524.     end
  3525.     else
  3526.     { Otherwise look for null terminator from Winsock }
  3527.     begin
  3528.       { If don't hit null terminator then add the char to op buffer }
  3529.       if TheTextToAdd[ Counter_1 ] <> #0 then
  3530.       begin
  3531.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  3532.       end
  3533.       else break; { Otherwise drop out of the loop }
  3534.     end;
  3535.   end;
  3536. end;
  3537.  
  3538. { This function scans a line of UNIX-style text for #10's and }
  3539. { outputs the first line as its return value,stopping at #0.  }
  3540. function TCCINetCCForm.AddNullTermTextToLabel( TheTextToAdd   : String ) : String;
  3541. var
  3542.   TheLine      : String;  { Buffer to output current line }
  3543.   TextLength ,            { Total chars to output         }
  3544.   Counter_1    : integer; { Loop Index                    }
  3545. begin
  3546.   { Clear output buffer }
  3547.   TheLine := '';
  3548.   { Find total chars to output }
  3549.   TextLength := Length( TheTextToAdd );
  3550.   { If none then leave }
  3551.   if TextLength = 0 then
  3552.   begin
  3553.     { Return nothing }
  3554.     Result := '';
  3555.     { Leave }
  3556.     exit;
  3557.   end;
  3558.   { Loop along the string }
  3559.   for Counter_1 := 1 to TextLength do
  3560.   begin
  3561.     { If hit ASCII 10 then assume end of line and output }
  3562.     if TheTextToAdd[ Counter_1 ] = #10 then
  3563.     begin
  3564.       { Return first line }
  3565.       Result := TheLine;
  3566.       { Leave }
  3567.       exit;
  3568.     end
  3569.     else
  3570.     { Otherwise look for null terminator from Winsock }
  3571.     begin
  3572.       { If don't hit null terminator then add the char to op buffer }
  3573.       if TheTextToAdd[ Counter_1 ] <> #0 then
  3574.       begin
  3575.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  3576.       end
  3577.       else break; { Otherwise drop out of the loop }
  3578.     end;
  3579.   end;
  3580.   { If hit #0 before #10 return buffer }
  3581.   Result := TheLine;
  3582. end;
  3583.  
  3584. { Show busy cursors }
  3585. procedure TCCINetCCForm.SetHGCursors;
  3586. begin
  3587.   CCInetCCForm.Cursor := crHourGlass;
  3588.   CCInetCCForm.Memo1.Cursor := crHourGlass;
  3589. end;
  3590.  
  3591. { Show normal cursors }
  3592. procedure TCCINetCCForm.SetNormalCursors;
  3593. begin
  3594.   CCInetCCForm.Cursor := crDefault;
  3595.   CCInetCCForm.Memo1.Cursor := crDefault;
  3596. end;
  3597.  
  3598. { Exit method }
  3599. procedure TCCINetCCForm.Exit1Click(Sender: TObject);
  3600. begin
  3601.   Close;
  3602. end;
  3603.  
  3604. { This method adds a line to the progress text stringlist  }
  3605. { If an exception occurs, the list is full, and it is auto }
  3606. { saved to the progress text file name, then cleared.      }
  3607. procedure TCCINetCCForm.AddProgressText( WhatText : String );
  3608. begin
  3609.   { Use a try..except loop to catch list overflows }
  3610.   try
  3611.     { Try the normal add }
  3612.     ProgressList.Add( WhatText );
  3613.   except
  3614.     { Any list error is assumed to be a list overflow }
  3615.     on EListError do
  3616.     begin
  3617.       { Save the list to the preset file name }
  3618.       ProgressList.SaveToFile( ProgressFileName );
  3619.       { Clear the list to make more room }
  3620.       ProgressList.Clear;
  3621.       { And redo the add; any further errors will except normally }
  3622.       ProgressList.Add( WhatText );
  3623.     end;
  3624.     { This might happen too! }
  3625.     on EOutOfResources do
  3626.     begin
  3627.       { Save the list to the preset file name }
  3628.       ProgressList.SaveToFile( ProgressFileName );
  3629.       { Clear the list to make more room }
  3630.       ProgressList.Clear;
  3631.       { And redo the add; any further errors will except normally }
  3632.       ProgressList.Add( WhatText );
  3633.     end;
  3634.   end;
  3635. end;
  3636.  
  3637. { This method either adds the progress line to the current memo }
  3638. { or puts it in the status caption at normal colors.            }
  3639. procedure TCCINetCCForm.ShowProgressText( WhatText : String );
  3640. begin
  3641.   { Use the POV to determine where to show progress info }
  3642.   case ProgressOutputVector of
  3643.     POV_MEMO : begin { Output into the memo  }
  3644.                  AddNullTermTextToMemo( WhatText , Memo1 );
  3645.                end;
  3646.     POV_STAT : begin { Output on status line }
  3647.                  { Set panel caption font to black }
  3648.                  Panel1.Font.Color := clBlack;
  3649.                  { Get the first line of text and put in caption }
  3650.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  3651.                end;
  3652.   end;
  3653. end;
  3654.  
  3655. { This method is identical with SPT except sets status color to red and beeps }
  3656. procedure TCCINetCCForm.ShowProgressErrorText( WhatText : String );
  3657. begin
  3658.   { Do error beep }
  3659.   MessageBeep( mb_IconExclamation );
  3660.   { Use the POV to determine where to show progress info }
  3661.   case ProgressOutputVector of
  3662.     POV_MEMO : begin { Output into the memo  }
  3663.                  AddNullTermTextToMemo( WhatText , Memo1 );
  3664.                end;
  3665.     POV_STAT : begin { Output on status line }
  3666.                  { Set panel caption font to black }
  3667.                  Panel1.Font.Color := clRed;
  3668.                  { Get the first line of text and put in caption }
  3669.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  3670.                end;
  3671.   end;
  3672. end;
  3673.  
  3674. { This is the boilerplate method used to handle Socket errors gracefully }
  3675. procedure TCCINetCCForm.SocketsErrorOccurred( Sender     : TObject;
  3676.                                               ErrorCode  : Integer;
  3677.                                               TheMessage : String   );
  3678. begin
  3679.   { Set the global error code flag }
  3680.   GlobalErrorCode := ErrorCode;
  3681.   { If a timeout error }
  3682.   if ErrorCode = WSAETIMEDOUT then
  3683.   begin
  3684.     { Set the aborted flag }
  3685.     GlobalAbortedFlag := True;
  3686.     { But clear the error code for graceful handling }
  3687.     GlobalErrorCode := 0;
  3688.   end
  3689.   else
  3690.   begin
  3691.     { Otherwise set the progress buffer to the error message }
  3692.     AddProgressText( TheMessage );
  3693.     { And show the progress text as set by option }
  3694.     ShowProgressErrorText( TheMessage );
  3695.   end;
  3696. end;
  3697.  
  3698. procedure TCCINetCCForm.FormCreate(Sender: TObject);
  3699. begin
  3700.   { Create the progress string list }
  3701.   ProgressList := TStringList.Create;
  3702.   { Create the file name for saving the progress list }
  3703.   ProgressFileName := ExpandFileName( 'PROGRESS.TXT' );
  3704.   { Default progress output to status line }
  3705.   ProgressOutputVector := POV_STAT;
  3706.   { Set password control stuff }
  3707.   PasswordControlVector := 2;
  3708.   CurrentPasswordString := 'guest@nowhere.com';
  3709.   CurrentRealPWString := 'guest@nowhere.com';
  3710.   NewMessageInProgress := false;
  3711.   EmailLoaded := false;
  3712.   NewsGroupListLoaded := false;
  3713.   { Get Ini file Data }
  3714.   ReadIniData;
  3715.   LoadFTPSiteFile;
  3716.   LoadNNTPSiteFile;
  3717.   LoadEMailServerFile;
  3718.   TheFTPComponent := TFTPComponent.Create( CCInetCCForm );
  3719.   TheFTPComponent.Parent := CCInetCCForm;
  3720.   TheNNTPComponent := TNNTPComponent.Create( CCInetCCForm );
  3721.   TheNNTPComponent.Parent := CCInetCCForm;
  3722.   TheUUObject := TUUCodingObject.Create( Self );
  3723.   TheUUObject.Parent := self;
  3724. end;
  3725.  
  3726. procedure TCCINetCCForm.FormDestroy(Sender: TObject);
  3727. begin
  3728.   { Free the progress text stringlist if assigned }
  3729.   if assigned( ProgressList ) then ProgressList.Free;
  3730.   { Save off the Ini data }
  3731.   WriteIniData;
  3732.   { Save and remove FTP site list stuff }
  3733.   SaveFTPSiteFile;
  3734.   SaveNNTPSiteFile;
  3735.   SaveEmailServerFile;
  3736.   if Assigned( TheFTPComponent ) then TheFTPComponent.Free;
  3737.   if Assigned( TheNNTPComponent ) then TheNNTPComponent.Free;
  3738.   if Assigned( TheUUObject ) then TheUUObject.Free;
  3739. end;
  3740.  
  3741. procedure TCCINetCCForm.Description1Click(Sender: TObject);
  3742. var
  3743.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3744.   TheData    : String;    { Holder for data                           }
  3745. begin
  3746.   { Create socket; auto calls WSAStartup }
  3747.   TempSocket := TCCSocket.Create( Self );
  3748.   { Do parent just for kicks; no longer needed }
  3749.   TempSocket.Parent := self;
  3750.   { Put in error handler }
  3751.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3752.   TheData := StrPas( TempSocket.Socket_WSA_Data.Description_String );
  3753.   { Display the Description String }
  3754.   AddProgressText( TheData );
  3755.   { And show the progress text as set by option }
  3756.   ShowProgressText( TheData );
  3757.   { Free the socket; auto calls WSACleanup }
  3758.   TempSocket.Free;
  3759. end;
  3760.  
  3761. procedure TCCINetCCForm.SystemStatus1Click(Sender: TObject);
  3762. var
  3763.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3764.   TheData    : String;    { Holder for data                           }
  3765. begin
  3766.   { Create socket; auto calls WSAStartup }
  3767.   TempSocket := TCCSocket.Create( Self );
  3768.   { Do parent just for kicks; no longer needed }
  3769.   TempSocket.Parent := self;
  3770.   { Put in error handler }
  3771.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3772.   TheData := StrPas( TempSocket.Socket_WSA_Data.System_Status_String );
  3773.   { Display the Description String }
  3774.   AddProgressText( TheData );
  3775.   { And show the progress text as set by option }
  3776.   ShowProgressText( TheData );
  3777.   { Free the socket; auto calls WSACleanup }
  3778.   TempSocket.Free;
  3779. end;
  3780.  
  3781. procedure TCCINetCCForm.VendorSpecific1Click(Sender: TObject);
  3782. var
  3783.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3784.   TheData    : String;    { Holder for data                           }
  3785. begin
  3786.   { Create socket; auto calls WSAStartup }
  3787.   TempSocket := TCCSocket.Create( Self );
  3788.   { Do parent just for kicks; no longer needed }
  3789.   TempSocket.Parent := self;
  3790.   { Put in error handler }
  3791.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3792.   TheData := StrPas( TempSocket.Socket_WSA_Data.Vendor_Specific_String );
  3793.   { Display the Description String }
  3794.   AddProgressText( TheData );
  3795.   { And show the progress text as set by option }
  3796.   ShowProgressText( TheData );
  3797.   { Free the socket; auto calls WSACleanup }
  3798.   TempSocket.Free;
  3799. end;
  3800.  
  3801. { This method sets the progress output vector to the memo }
  3802. procedure TCCINetCCForm.ViewInEditWindow1Click(Sender: TObject);
  3803. begin
  3804.   { Set the vector }
  3805.   ProgressOutputVector := POV_MEMO;
  3806.   { Keep the menu options consistent }
  3807.   ViewInEditWindow1.Checked := true;
  3808.   ViewInStatusLine1.Checked := false;
  3809. end;
  3810.  
  3811. { This method sets the progress output vector to the status line }
  3812. procedure TCCINetCCForm.ViewInStatusLine1Click(Sender: TObject);
  3813. begin
  3814.   { Set the vector }
  3815.   ProgressOutputVector := POV_STAT;
  3816.   { Keep the menus consistent }
  3817.   ViewInEditWindow1.Checked := false;
  3818.   ViewInStatusLine1.Checked := true;
  3819. end;
  3820.  
  3821. procedure TCCINetCCForm.SaveToFile1Click(Sender: TObject);
  3822. begin
  3823.   { Set up the dialog parameters }
  3824.   OpenDialog1.Filename := ProgressFileName;
  3825.   OpenDialog1.Title := 'Select Filename for Progress File';
  3826.   OpenDialog1.Filter := 'Text Files|*.txt';
  3827.   { If the dialog is not cancelled then save and clear }
  3828.   if OpenDialog1.Execute then
  3829.   begin
  3830.     ProgressFileName := OpenDialog1.FileName;
  3831.     ProgressList.SaveToFile( ProgressFileName );
  3832.     ProgressList.Clear;
  3833.   end;
  3834. end;
  3835.  
  3836. procedure TCCINetCCForm.IPAddress1Click(Sender: TObject);
  3837. begin
  3838.   { Set up info dialog for IP Address getting }
  3839.   CCICInfoDlg.Caption := 'CC Internet Center -- Translate IP Address';
  3840.   CCICInfoDlg.Panel4.Visible := false;
  3841.   CCICInfoDlg.Panel6.Visible := false;
  3842.   CCICInfoDlg.Panel9.Visible := false;
  3843.   CCICInfoDlg.Panel8.Visible := false;
  3844.   CCICInfoDlg.BitBtn2.Visible := false;
  3845.   CCICInfoDlg.Button1.Caption := 'Get IP Address';
  3846.   CCICInfoDlg.Button2.Visible := false;
  3847.   CCICInfoDlg.Button3.Visible := false;
  3848.   CCICInfoDlg.Button4.Visible := false;
  3849.   CCICInfoDlg.Panel2.Caption := 'IP Addr Name:';
  3850.   CCICInfoDlg.Panel3.Caption := '    Dotted Dec:';
  3851.   CCICInfoDlg.Panel5.Caption := '           Binary:';
  3852.   CCICInfoDlg.Edit1.Text := '';
  3853.   CCICInfoDlg.Edit2.Text := '';
  3854.   CCICInfoDlg.Edit3.Text := '';
  3855.   { Set IP Address Mode }
  3856.   CCICInfoDlg.Tag := 1;
  3857.   { Show Modally to get the information }
  3858.   CCICInfoDlg.ShowModal;
  3859.   { Reset the info dialog to default conditions }
  3860.   CCICInfoDlg.Caption := 'CC Internet Command Center Information Dialog';
  3861.   CCICInfoDlg.Panel4.Visible := true;
  3862.   CCICInfoDlg.Panel6.Visible := true;
  3863.   CCICInfoDlg.Panel9.Visible := true;
  3864.   CCICInfoDlg.Panel8.Visible := true;
  3865.   CCICInfoDlg.BitBtn2.Visible := true;
  3866.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  3867.   CCICInfoDlg.Button2.Visible := true;
  3868.   CCICInfoDlg.Button3.Visible := true;
  3869.   CCICInfoDlg.Button4.Visible := true;
  3870.   CCICInfoDlg.Panel2.Caption := '             Name:';
  3871.   CCICInfoDlg.Panel3.Caption := '    IP Address:';
  3872.   CCICInfoDlg.Panel5.Caption := ' User Name:';
  3873.   CCICInfoDlg.Edit1.Text := '';
  3874.   CCICInfoDlg.Edit2.Text := '';
  3875.   CCICInfoDlg.Edit3.Text := '';
  3876. end;
  3877.  
  3878. procedure TCCINetCCForm.FTP1Click(Sender: TObject);
  3879. begin
  3880.   { Set up the FTP Data displays }
  3881.   SetupFTPSiteLists;
  3882.   ListBox1.Clear;
  3883.   ListBox2.Clear;
  3884. end;
  3885.  
  3886. procedure TCCINetCCForm.FormResize(Sender: TObject);
  3887. begin
  3888.   { Use tag vector to determine what to do }
  3889.   case Tag of
  3890.     { if FTP , make sure two list boxes are same height }
  3891.     2 : begin
  3892.           Panel6.Height := (( Panel4.Height div 2 ) - 30 );
  3893.           Panel4.Width := 185;
  3894.         end;
  3895.     4 : begin
  3896.           Panel6.Height := 118;
  3897.           Panel4.Width := 250;
  3898.         end;
  3899.   end;
  3900. end;
  3901.  
  3902. procedure TCCINetCCForm.FTPSites1Click(Sender: TObject);
  3903. begin
  3904.   { Show Modally to get the information }
  3905.   CCICInfoDlg.ShowModal;
  3906. end;
  3907.  
  3908. procedure TCCINetCCForm.FTP3Click(Sender: TObject);
  3909. begin
  3910.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 1;
  3911.   CCICPrefsDlg.Tag := 2;
  3912.   CCICPrefsDlg.ShowModal;
  3913. end;
  3914.  
  3915. procedure TCCINetCCForm.ConnectToSite1Click(Sender: TObject);
  3916. var Counter_1 : Integer;
  3917. begin
  3918.   if Lowercase( PConnectionsRecord( TheFTPSiteList.Items[
  3919.    ComboBox1.ItemIndex ] )^.CUserName ) = 'anonymous' then
  3920.   begin
  3921.     for Counter_1 := 1 to TheAnonRedialVector do
  3922.     begin
  3923.       DoFTPConnection( PConnectionsRecord(
  3924.          TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  3925.       if TheFTPComponent.Connection_Established then exit;
  3926.     end;
  3927.   end
  3928.   else DoFTPConnection( PConnectionsRecord(
  3929.    TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  3930. end;
  3931.  
  3932. procedure TCCINetCCForm.Button1Click(Sender: TObject);
  3933. begin
  3934.   case Tag of
  3935.     2 : begin
  3936.           if not TheFTPComponent.Connection_Established then
  3937.            ConnectToSite1Click( Self ) else
  3938.            begin
  3939.              DoFTPDisconnect;
  3940.              TheFTPComponent.Connection_Established := false;
  3941.              DisableFTPMenus;
  3942.            end;
  3943.         end;
  3944.     4 : begin
  3945.           ConnectAndUpdate1Click( Self );
  3946.         end;
  3947.     5 : begin
  3948.           GetMarked1Click( Self );
  3949.         end;
  3950.   end;
  3951. end;
  3952.  
  3953. procedure TCCINetCCForm.ViewasText1Click(Sender: TObject);
  3954. begin
  3955.   { Assume valid FTP component and have it send its text into the progress text}
  3956.   TheFTPComponent.GetRemoteDirectoryListingToMemo;
  3957. end;
  3958.  
  3959. procedure TCCINetCCForm.Disconnect1Click(Sender: TObject);
  3960. begin
  3961.   DoFTPDisconnect;
  3962.   DisableFTPMenus;
  3963. end;
  3964.  
  3965. procedure TCCINetCCForm.EnableFTPMenus;
  3966. begin
  3967.   Button1.Caption := 'Disconnect';
  3968.   ConnectToSite1.Enabled := false;
  3969.   Disconnect1.Enabled := true;
  3970.   Directory1.Enabled := true;
  3971.   UploadMarked1.Enabled := true;
  3972.   DownloadMarked1.Enabled := true;
  3973. end;
  3974.  
  3975. procedure TCCINetCCForm.DisableFTPMenus;
  3976. begin
  3977.   Button1.Caption := 'Connect';
  3978.   ConnectToSite1.Enabled := true;
  3979.   Disconnect1.Enabled := false;
  3980.   Directory1.Enabled := false;
  3981.   UploadMarked1.Enabled := false;
  3982.   DownloadMarked1.Enabled := false;
  3983.   FTP1.Enabled := true;
  3984.   UseNetNws1.Enabled := true;
  3985.   IPAddress1.Enabled := true;
  3986.   FTP2.Enabled := false;
  3987. end;
  3988.  
  3989. procedure TCCINetCCForm.EnableNNTPMenus;
  3990. begin
  3991.   Button1.Caption := 'Disconnect';
  3992.   ConnectAndUpdate1.Enabled := false;
  3993.   Disconnect2.Enabled := true;
  3994.   CheckNewNews1.Enabled := true;
  3995.   GetMarked1.Enabled := true;
  3996.   Article1.Enabled := true;
  3997.   Post1.Enabled := true;
  3998.   SubScribedNewsgroups1.Enabled := true;
  3999.   Trash1.Enabled := true;
  4000.   Headers1.Enabled := true;
  4001.   DownLoadActiveNewsGroups1.Enabled := true;
  4002. end;
  4003.  
  4004. procedure TCCINetCCForm.DisableNNTPMenus;
  4005. begin
  4006.   Button1.Caption := 'Connect';
  4007.   ConnectAndUpdate1.Enabled := True;
  4008.   Disconnect2.Enabled := false;
  4009.   CheckNewNews1.Enabled := false;
  4010.   GetMarked1.Enabled := false;
  4011.   Article1.Enabled := false;
  4012.   Post1.Enabled := false;
  4013.   SubScribedNewsgroups1.Enabled := false;
  4014.   Trash1.Enabled := false;
  4015.   Headers1.Enabled := false;
  4016.   DownLoadActiveNewsGroups1.Enabled := false;
  4017. end;
  4018.  
  4019. procedure TCCINetCCForm.ToDisplay1Click(Sender: TObject);
  4020. var Counter_1 : Integer;
  4021. begin
  4022.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  4023.   begin
  4024.     if Listbox1.Selected[ Counter_1 ] then
  4025.     begin
  4026.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  4027.       TheFTPComponent.
  4028.        ReceiveASCIIRemoteFileToMemo( Listbox1.Items[ Counter_1 ] );
  4029.     end;
  4030.   end;
  4031. end;
  4032.  
  4033. procedure TCCINetCCForm.ToFile1Click(Sender: TObject);
  4034. var Counter_1 : Integer;
  4035.     W16Name   : String;
  4036. begin
  4037.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  4038.   begin
  4039.     if Listbox1.Selected[ Counter_1 ] then
  4040.     begin
  4041.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  4042.       W16Name := TheFTPComponent.GetWin16Filename( FileNameToXFer );
  4043.       TheFTPComponent.
  4044.        ReceiveASCIIRemoteFile( Listbox1.Items[ Counter_1 ] , W16Name );
  4045.     end;
  4046.   end;
  4047. end;
  4048.  
  4049. procedure TCCINetCCForm.Binary2Click(Sender: TObject);
  4050. var Counter_1 : Integer;
  4051.     W16Name   : String;
  4052. begin
  4053.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  4054.   begin
  4055.     if Listbox1.Selected[ Counter_1 ] then
  4056.     begin
  4057.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  4058.       W16Name := TheFTPComponent.GetWin16Filename( FileNameToXFer );
  4059.       TheFTPComponent.
  4060.        ReceiveBinaryRemoteFile( Listbox1.Items[ Counter_1 ] , W16Name );
  4061.     end;
  4062.   end;
  4063. end;
  4064.  
  4065. procedure TCCINetCCForm.Change1Click(Sender: TObject);
  4066. var TheDir : String;
  4067. begin
  4068.   if ListBox1.ItemIndex = -1 then exit;
  4069.   TheDir := ListBox1.Items[ ListBox1.ItemIndex ];
  4070.   if TheFTPComponent.SetRemoteDirectory( TheDir ) then
  4071.   begin
  4072.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir ); 
  4073.     { Put up remote directory via PWD and strip quotes }
  4074.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  4075.     { Get the listings of directories and exit OK }
  4076.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  4077.   end;
  4078. end;
  4079.  
  4080. procedure TCCINetCCForm.ChangeLocal1Click(Sender: TObject);
  4081. var TheDir : String;
  4082. begin
  4083.   if ListBox2.ItemIndex = -1 then exit;
  4084.   TheDir := ListBox2.Items[ ListBox2.ItemIndex ];
  4085.   TheDir := TheFTPComponent.StripBrackets( TheDir );
  4086.   if TheDir = '..' then
  4087.   begin
  4088.     ChDir( TheDir );
  4089.   end
  4090.   else
  4091.   begin
  4092.     TheDir := ExpandFileName( TheDir );
  4093.     ChDir( TheDir );
  4094.   end;
  4095.   TheFTPComponent.GetLocalDirectoryAndListing( TheDir , Listbox2 );
  4096.   if Label5.Canvas.TextWidth( TheDir ) > Label5.Width then
  4097.    TheDir := TheFTPComponent.GetShortPathName( TheDir );
  4098.   Label5.Caption := TheDir;
  4099. end;
  4100.  
  4101. procedure TCCINetCCForm.ListBox1DblClick(Sender: TObject);
  4102. begin
  4103.   case Tag of
  4104.     2 : begin
  4105.           case DefaultDownLoadVector of
  4106.             1 : Binary2Click( Self );
  4107.             2 : ToFile1Click( Self );
  4108.             3 : Change1Click( Self );
  4109.           end;
  4110.         end;
  4111.   end;
  4112. end;
  4113.  
  4114. procedure TCCINetCCForm.ListBox2DblClick(Sender: TObject);
  4115. var WorkingString ,
  4116.     NumberString    : String;
  4117.     TheIDNumber     : Integer;
  4118.     TheNGARecord    : PNewsGroupArticleRecord;
  4119. begin
  4120.   case Tag of
  4121.     2 : begin
  4122.           case DefaultDownLoadVector of
  4123.             1 : Binary1Click( Self );
  4124.             2 : ASCII1Click( Self );
  4125.             3 : ChangeLocal1Click( Self );
  4126.           end;
  4127.         end;
  4128.     5 : begin
  4129.           if ListBox2.Tag <> 5 then exit;
  4130.           if ListBox2.ItemIndex = -1 then exit;
  4131.           WorkingString := ListBox2.Items[ ListBox2.ItemIndex ];
  4132.           NumberString := TheFTPComponent.StripBrackets( WorkingString );
  4133.           TheIDNumber := StrToInt( NumberString );
  4134.           TheNGARecord := PNewsGroupArticleRecord(
  4135.            TheNGArticlesList.Items[ TheIDNumber ] );
  4136.           if TheNGARecord^.NGADownloaded then
  4137.           begin
  4138.             Memo1.Clear;
  4139.             try
  4140.               Memo1.Lines.LoadFromFile( NewsPath + '\' + TheNGARecord^.NGAArtFileName );
  4141.             except
  4142.               MessageDlg( 'Article Too Large to Load! Use Write to View [' +
  4143.                TheNGARecord^.NGAArtFilename + '.',
  4144.                mtError,[mbOK],0);
  4145.               exit;
  4146.             end;
  4147.             Label1.Caption := 'Subject:';
  4148.             ComboBox1.Text := TheNGARecord^.NGASubject;
  4149.             TheNGARecord^.NGARead := true;
  4150.             WorkingString := ListBox2.Items[ ListBox2.ItemIndex ];
  4151.             WorkingString[ 3 ] := 'R';
  4152.             ListBox2.Items[ ListBox2.ItemIndex ] := WorkingString;
  4153.           end
  4154.           else
  4155.           begin
  4156.             MessageDlg( 'Article Not Downloaded!',mtError,[mbOK],0);
  4157.           end;
  4158.         end;
  4159.   end;
  4160. end;
  4161.  
  4162. procedure TCCINetCCForm.ASCII1Click(Sender: TObject);
  4163. var Counter_1 : Integer;
  4164.     TheDir    : String;
  4165. begin
  4166.   for Counter_1 := 0 to Listbox2.Items.Count - 1 do
  4167.   begin
  4168.     if Listbox2.Selected[ Counter_1 ] then
  4169.     begin
  4170.       FileNameToXFer := ListBox2.Items[ Counter_1 ];
  4171.       TheFTPComponent.
  4172.        SendASCIILocalFile( Listbox2.Items[ Counter_1 ] );
  4173.     end;
  4174.   end;
  4175.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  4176.   { Put up remote directory via PWD and strip quotes }
  4177.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  4178.   { Get the listings of directories and exit OK }
  4179.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  4180. end;
  4181.  
  4182. procedure TCCINetCCForm.DeleteRemoteFiles1Click(Sender: TObject);
  4183. var Counter_1 : Integer;
  4184.     TheDir    : String;
  4185.     DoAll     : Boolean;
  4186.     TheResult : Integer;
  4187. begin
  4188.   DoAll := false;
  4189.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  4190.   begin
  4191.     if Listbox1.Selected[ Counter_1 ] then
  4192.     begin
  4193.       if not DoAll then
  4194.       begin
  4195.         TheResult := MessageDlg( 'Delete Remote File ' +
  4196.          ListBox1.Items[ Counter_1 ] + ' ?',mtConfirmation,
  4197.           [mbYes,mbNo,mbCancel,mbAll],0 );
  4198.         case TheResult of
  4199.           mrYes : ;
  4200.           mrNo  : ;
  4201.           mrCancel : break;
  4202.           mrAll : begin
  4203.                     TheResult := mrYes;
  4204.                     DoAll := true;
  4205.                   end;
  4206.         end;
  4207.       end
  4208.       else TheResult := mrYes;
  4209.       if TheResult = mrYes then TheFTPComponent.
  4210.          DeleteRemoteFile( Listbox1.Items[ Counter_1 ] );
  4211.     end;
  4212.   end;
  4213.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  4214.   { Put up remote directory via PWD and strip quotes }
  4215.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  4216.   { Get the listings of directories and exit OK }
  4217.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  4218. end;
  4219.  
  4220. procedure TCCINetCCForm.Binary1Click(Sender: TObject);
  4221. var Counter_1 : Integer;
  4222.     TheDir    : String;
  4223. begin
  4224.   for Counter_1 := 0 to Listbox2.Items.Count - 1 do
  4225.   begin
  4226.     if Listbox2.Selected[ Counter_1 ] then
  4227.     begin
  4228.       FileNameToXFer := ListBox2.Items[ Counter_1 ];
  4229.       TheFTPComponent.
  4230.        SendBinaryLocalFile( Listbox2.Items[ Counter_1 ] );
  4231.     end;
  4232.   end;
  4233.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  4234.   { Put up remote directory via PWD and strip quotes }
  4235.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  4236.   { Get the listings of directories and exit OK }
  4237.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  4238. end;
  4239.  
  4240. procedure TCCINetCCForm.Delete3Click(Sender: TObject);
  4241. var Counter_1 : Integer;
  4242.     TheDir    : String;
  4243. begin
  4244.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  4245.   begin
  4246.     if Listbox1.Selected[ Counter_1 ] then
  4247.     begin
  4248.       if ListBox1.Items[ Counter_1 ] <> '..' then
  4249.        TheFTPComponent.
  4250.         DeleteRemoteDirectory( Listbox1.Items[ Counter_1 ] );
  4251.     end;
  4252.   end;
  4253.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  4254.   { Put up remote directory via PWD and strip quotes }
  4255.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  4256.   { Get the listings of directories and exit OK }
  4257.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  4258. end;
  4259.  
  4260. procedure TCCINetCCForm.Create1Click(Sender: TObject);
  4261. var TheDir : String;
  4262. begin
  4263.   OpenDialog1.Filename := '*.*';
  4264.   OpenDialog1.Title := 'Enter Remote Directory Name';
  4265.   if OpenDialog1.Execute then
  4266.   begin
  4267.     TheFTPComponent.
  4268.      CreateRemoteDirectory( ExtractFileName( OpenDialog1.FileName ));
  4269.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  4270.     { Put up remote directory via PWD and strip quotes }
  4271.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  4272.     { Get the listings of directories and exit OK }
  4273.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  4274.   end;
  4275. end;
  4276.  
  4277. procedure TCCINetCCForm.ListBox1Click(Sender: TObject);
  4278. var TheNGRecord : PNewsGroupRecord;
  4279.     TheMBRecord : PEMailMailboxRecord;
  4280. begin
  4281.   case ListBox1.Tag of
  4282.     5 : begin
  4283.           if ListBox1.ItemIndex = -1 then exit;
  4284.           TheNGRecord :=
  4285.            PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4286.           TheNGArticlesList := TList( TheNGRecord^.GLTag );
  4287.           PopulateLB2WithArticleHeaders;
  4288.           ComboBox1.ItemIndex := ListBox1.ItemIndex;
  4289.         end;
  4290.   end;
  4291. end;
  4292.  
  4293. procedure TCCINetCCForm.UsenetNws1Click(Sender: TObject);
  4294. begin
  4295.   if TheFTPComponent.Connection_Established then
  4296.   begin
  4297.     MessageDlg( 'Must disconnect from current FTP session first!',
  4298.      mtError,[mbOK],0);
  4299.     exit;
  4300.   end;
  4301.   { Show The NNTP servers display }
  4302.   ListBox1.Clear;
  4303.   ListBox2.Clear;
  4304.   SetupNNTPSiteLists;
  4305.   NewsGroupListLoaded := false;
  4306.   SetupNNTPServersInfoDisplay;
  4307. end;
  4308.  
  4309. procedure TCCINetCCForm.Disconnect2Click(Sender: TObject);
  4310. begin
  4311.   SaveNNTPNewsGroupLists;
  4312.   DoNNTPDisconnect;
  4313.   DisableNNTPMenus;
  4314.   ListBox1.Clear;
  4315.   ListBox2.Clear;
  4316. end;
  4317.  
  4318. procedure TCCINetCCForm.News2Click(Sender: TObject);
  4319. begin
  4320.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 2;
  4321.   CCICPrefsDlg.Tag := 4;
  4322.   CCICPrefsDlg.ShowModal;
  4323. end;
  4324.  
  4325. procedure TCCINetCCForm.ConnectandUpdate1Click(Sender: TObject);
  4326. begin
  4327.   DoNNTPConnection( PConnectionsRecord(
  4328.      TheNewsServerList.Items[ ComboBox1.ItemIndex ] ));
  4329.   if TheNNTPComponent.Connection_Established then
  4330.   begin
  4331.     SetupNNTPNewsGroupLists;
  4332.     if NewsInitialUpdateVector = 1 then
  4333.     begin { Update all active newsgroups }
  4334.       TheNNTPComponent.CheckAllNewNews;
  4335.     end;
  4336.     { Bring up the files with current NG information }
  4337.     SetupNewsGroupListboxes;
  4338.   end;
  4339. end;
  4340.  
  4341. procedure TCCINetCCForm.CheckNewNews1Click(Sender: TObject);
  4342. begin
  4343.   TheNNTPComponent.CheckAllNewNews;
  4344.   SetupNewsGroupListboxes;
  4345. end;
  4346.  
  4347. procedure TCCINetCCForm.NewsServers1Click(Sender: TObject);
  4348. begin
  4349.   { Reset display to NNTP Servers }
  4350.   SetupNNTPServersInfoDisplay;
  4351.   { Show Modally to get the information }
  4352.   CCICInfoDlg.ShowModal;
  4353. end;
  4354.  
  4355. procedure TCCINetCCForm.SubscribedNewsgroups1Click(Sender: TObject);
  4356. begin
  4357.   { Reset display to Usenet Newsgroups }
  4358.   SetupNNTPNewsGroupsInfoDisplay;
  4359.   { Show Modally to get the information }
  4360.   CCICInfoDlg.ShowModal;
  4361.   TheNNTPComponent.CheckAllNewNews;
  4362.   SetupNewsGroupListboxes;
  4363. end;
  4364.  
  4365. procedure TCCINetCCForm.RetrieveMarked1Click(Sender: TObject);
  4366. var Counter_1   : Integer;
  4367.     TheNGRecord : PNewsGroupRecord;
  4368. begin
  4369.   for Counter_1 := 0 to ListBox1.Items.Count - 1 do
  4370.   begin
  4371.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  4372.     if (( TheNGRecord^.GSubscribed ) and ( ListBox1.Selected[ Counter_1 ] )) then
  4373.     begin
  4374.       TheNNTPComponent.GetAllArticleHeaders( TheNGRecord );
  4375.     end;
  4376.   end;
  4377.   SetupNewsGroupListboxes;
  4378. end;
  4379.  
  4380. procedure TCCINetCCForm.RetrieveAll1Click(Sender: TObject);
  4381. var Counter_1   : Integer;
  4382.     TheNGRecord : PNewsGroupRecord;
  4383. begin
  4384.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  4385.   begin
  4386.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  4387.     if TheNGRecord^.GSubscribed then
  4388.     begin
  4389.       TheNNTPComponent.GetAllArticleHeaders( TheNGRecord );
  4390.     end;
  4391.   end;
  4392.   SetupNewsGroupListboxes;
  4393. end;
  4394.  
  4395. procedure TCCINetCCForm.GetMarked1Click(Sender: TObject);
  4396. var TheNGRecord : PNewsGroupRecord;
  4397. begin
  4398.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4399.   TheNNTPComponent.DownloadAllMarkedArticleListings( TheNGRecord , ListBox2 );
  4400.   SetupNewsGroupListboxes;
  4401. end;
  4402.  
  4403. procedure TCCINetCCForm.NewArticle1Click(Sender: TObject);
  4404. begin
  4405.   if ListBox1.ItemIndex = -1 then exit;
  4406.   Memo1.Clear;
  4407.   TheNNTPComponent.SetNewsHeaders( Memo1 , ListBox1.ItemIndex );
  4408. end;
  4409.  
  4410. procedure TCCINetCCForm.FollowupArticle1Click(Sender: TObject);
  4411. begin
  4412.   if ListBox1.ItemIndex = -1 then exit;
  4413.   if ListBox2.ItemIndex = -1 then exit;
  4414.   Memo1.Clear;
  4415.   TheNNTPComponent.SetFUNewsHeaders( Memo1              ,
  4416.                                      ListBox1.ItemIndex ,
  4417.                                      ListBox2.ItemIndex   );
  4418. end;
  4419.  
  4420. procedure TCCINetCCForm.PutinQueue1Click(Sender: TObject);
  4421. var TheNGRecord : PNewsGroupRecord;
  4422.     TheNGARecord : PNewsGroupArticleRecord;
  4423.     WorkingList : TList;
  4424.     WorkingFilename : String;
  4425.     Holdingposition : Integer;
  4426. begin
  4427.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4428.   WorkingList := TList( TheNGRecord^.GLTag );
  4429.   New( TheNGARecord );
  4430.   with TheNGARecord^ do
  4431.   begin
  4432.     NGAGroupname   := TheNGRecord^.GRealName;
  4433.     NGASubject     := TheNNTPComponent.GetHeaderSubject( TStringList( Memo1.Lines ));
  4434.     NGANumber      := TheNGRecord^.GHighestAvailable + WorkingList.Count;
  4435.     NGADownloaded  := true;
  4436.     NGASender      := 'CIUPKC158';
  4437.     NGARead        := false;
  4438.     NGAPosted      := false;
  4439.     WorkingFileName := 'AR' + IntToStr( NGANumber );
  4440.     if Length( WorkingFileName ) > 8 then
  4441.      WorkingFileName := Copy( WorkingFileName ,1 , 8 );
  4442.     WorkingFileName := WorkingFileName + '.' + IntToStr( TheNGRecord^.GIDNumber );
  4443.     NGAArtFileName := WorkingFileName;
  4444.   end;
  4445.   WorkingList.Add( TheNGARecord );
  4446.   Memo1.Lines.SaveToFile( NewsPath + '\' + WorkingFileName );
  4447.   HoldingPosition := ListBox1.itemindex;
  4448.   SetupNewsGroupListboxes;
  4449.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ HoldingPosition ] );
  4450.   TheNGArticlesList := TList( TheNGRecord^.GLTag );
  4451.   PopulateLB2WithArticleHeaders;
  4452. end;
  4453.  
  4454. procedure TCCINetCCForm.CurrentArticle1Click(Sender: TObject);
  4455. var TheNGARecord : PNewsGroupArticleRecord;
  4456.     TheNGRecord  : PNewsGroupRecord;
  4457.     HP : Integer;
  4458. begin
  4459.   HP := ListBox1.itemindex;
  4460.   PutInQueue1Click( Self );
  4461.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ HP ] );
  4462.   TheNGArticlesList := TList( TheNGRecord^.GLTag );
  4463.   TheNGARecord := PNewsGroupArticleRecord( TheNGArticlesList.Items[ TheNGArticlesList.Count - 1 ] );
  4464.   TheNNTPComponent.UploadArticleListing( TheNGARecord );
  4465. end;
  4466.  
  4467. procedure TCCINetCCForm.EntireQueue1Click(Sender: TObject);
  4468. var TheNGRecord : PNewsGroupRecord;
  4469. begin
  4470.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4471.   TheNNTPComponent.UploadAllArticleListings( TheNGRecord );
  4472. end;
  4473.  
  4474. procedure TCCINetCCForm.AllReadArticles1Click(Sender: TObject);
  4475. var TheNGRecord : PNewsGroupRecord;
  4476. begin
  4477.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4478.   TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4479.   SetupNewsGroupListboxes;
  4480. end;
  4481.  
  4482. procedure TCCINetCCForm.AllMarkedArticles1Click(Sender: TObject);
  4483. var TheNGRecord : PNewsGroupRecord;
  4484.     TheNGARecord : PNewsGroupArticleRecord;
  4485.     WorkingList : TList;
  4486.     Counter_1 : Integer;
  4487. begin
  4488.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4489.   WorkingList := TList( TheNGRecord^.GLTag );
  4490.   for Counter_1 := 0 to ListBox2.Items.Count - 1 do
  4491.   begin
  4492.     if ListBox2.Selected[ Counter_1 ] then
  4493.     begin
  4494.       TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  4495.       TheNGARecord^.NGARead := true;
  4496.     end;
  4497.   end;
  4498.   TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4499.   SetupNewsGroupListboxes;
  4500. end;
  4501.  
  4502. procedure TCCINetCCForm.AllAvailableArticles1Click(Sender: TObject);
  4503. var TheNGRecord : PNewsGroupRecord;
  4504.     TheNGARecord : PNewsGroupArticleRecord;
  4505.     WorkingList : TList;
  4506.     Counter_1  : Integer;
  4507. begin
  4508.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4509.   WorkingList := TList( TheNGRecord^.GLTag );
  4510.   for Counter_1 := 0 to ListBox2.Items.Count - 1 do
  4511.   begin
  4512.     TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  4513.     TheNGARecord^.NGARead := true;
  4514.   end;
  4515.   TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4516.   SetupNewsGroupListboxes;
  4517. end;
  4518.  
  4519. procedure TCCINetCCForm.DownloadActiveNewsgroups1Click(Sender: TObject);
  4520. begin
  4521.   if MessageDlg( 'This will take considerable time. Proceed?',mtConfirmation,
  4522.    mbYesNoCancel,0) = mrYes then
  4523.   begin
  4524.     Memo1.Clear;
  4525.     TheNNTPComponent.GetListofAvailableNewsGroups;
  4526.   end;
  4527. end;
  4528.  
  4529. procedure TCCINetCCForm.UUEncode1Click(Sender: TObject);
  4530. begin
  4531.   OpenDialog1.Filename := '*.*';
  4532.   OpenDialog1.Title := 'Select File to UUENCODE';
  4533.   if OpenDialog1.Execute then
  4534.   begin
  4535.     TheUUObject.SetInputFileName( OpenDialog1.FileName );
  4536.     TheUUObject.EncodeCurrentInputs;
  4537.   end;
  4538. end;
  4539.  
  4540. procedure TCCINetCCForm.Load1Click(Sender: TObject);
  4541. var Memo2 : TMemo;
  4542.     Counter_1 : Integer;
  4543. begin
  4544.   OpenDialog1.Filename := '*.txt';
  4545.   OpenDialog1.Title := 'Select File to load into Memo';
  4546.   if OpenDialog1.Execute then
  4547.   begin
  4548.     Memo2 := TMemo.Create( Self );
  4549.     Memo2.Parent := Self;
  4550.     Memo2.Visible := false;
  4551.     Memo2.Width := Memo1.Width;
  4552.     Memo2.Height := Memo1.Height;
  4553.     Memo2.Lines.LoadFromFile( OpenDialog1.FileName );
  4554.     for Counter_1 := 0 to Memo2.Lines.Count - 1 do
  4555.      Memo1.Lines.Add( Memo2.Lines[ Counter_1 ] );
  4556.     Memo2.Free;
  4557.   end;
  4558. end;
  4559.  
  4560. procedure TCCINetCCForm.Save1Click(Sender: TObject);
  4561. begin
  4562.   SaveDialog1.Filename := '*.txt';
  4563.   SaveDialog1.Title := 'Select File to Save Memo to';
  4564.   if OpenDialog1.Execute then
  4565.   begin
  4566.     Memo1.Lines.SaveToFile( SaveDialog1.FileName );
  4567.   end;
  4568. end;
  4569.  
  4570. procedure TCCINetCCForm.EMail1Click(Sender: TObject);
  4571. begin
  4572.   if TheFTPComponent.Connection_Established then
  4573.   begin
  4574.     MessageDlg( 'Must disconnect from current FTP session first!',
  4575.      mtError,[mbOK],0);
  4576.     exit;
  4577.   end;
  4578.   if TheNNTPComponent.Connection_Established then
  4579.   begin
  4580.     MessageDlg( 'Must disconnect from current NNTP session first!',
  4581.      mtError,[mbOK],0);
  4582.     exit;
  4583.   end;
  4584.   { Show The POP3SMTP servers display }
  4585.   ListBox1.Clear;
  4586.   ListBox2.Clear;
  4587.   SetupEMailServerStatus;
  4588.   EnablePOP3SMTPMenus;
  4589.   SetupEMailServersInfoDisplay;
  4590. end;
  4591.  
  4592. procedure TCCINetCCForm.MailServers1Click(Sender: TObject);
  4593. begin
  4594.   SetupEmailServersInfoDisplay;
  4595.   CCICInfoDlg.ShowModal;
  4596. end;
  4597.  
  4598. procedure TCCINetCCForm.EMail3Click(Sender: TObject);
  4599. begin
  4600.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 0;
  4601.   CCICPrefsDlg.Tag := 6;
  4602.   CCICPrefsDlg.ShowModal;
  4603. end;
  4604.  
  4605. procedure TCCINetCCForm.Paths1Click(Sender: TObject);
  4606. begin
  4607.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 3;
  4608.   CCICPrefsDlg.Tag := 3;
  4609.   CCICPrefsDlg.ShowModal;
  4610. end;
  4611.  
  4612. procedure TCCINetCCForm.Cut1Click(Sender: TObject);
  4613. begin
  4614.   Memo1.CutToClipboard;
  4615. end;
  4616.  
  4617. procedure TCCINetCCForm.Copy1Click(Sender: TObject);
  4618. begin
  4619.   Memo1.CopyToClipboard;
  4620. end;
  4621.  
  4622. procedure TCCINetCCForm.CopytoFile1Click(Sender: TObject);
  4623. var TempMemo : TMemo;
  4624. begin
  4625.   TempMemo := TMemo.Create( self );
  4626.   TempMemo.parent := self;
  4627.   Tempmemo.Visible := false;
  4628.   TempMemo.Width := Memo1.Width;
  4629.   TempMemo.Height := Memo1.Height;
  4630.   Memo1.CopyToClipboard;
  4631.   TempMemo.PasteFromClipboard;
  4632.   SaveDialog1.Filename := '*.TXT';
  4633.   SaveDialog1.Title := 'Select File to Save To';
  4634.   if SaveDialog1.Execute then TempMemo.Lines.SaveToFile( SaveDialog1.Filename );
  4635.   TempMemo.Free;
  4636. end;
  4637.  
  4638. procedure TCCINetCCForm.Paste1Click(Sender: TObject);
  4639. begin
  4640.   Memo1.PasteFromClipboard;
  4641. end;
  4642.  
  4643. procedure TCCINetCCForm.PastefromFile1Click(Sender: TObject);
  4644. var TempMemo : TMemo;
  4645. begin
  4646.   TempMemo := TMemo.Create( self );
  4647.   TempMemo.parent := self;
  4648.   Tempmemo.Visible := false;
  4649.   TempMemo.Width := Memo1.Width;
  4650.   TempMemo.Height := Memo1.Height;
  4651.   OpenDialog1.Filename := '*.*';
  4652.   OpenDialog1.Title := 'Select File to Paste From';
  4653.   if OpenDialog1.Execute then TempMemo.Lines.LoadFromFile( OpenDialog1.Filename );
  4654.   TempMemo.SelectAll;
  4655.   TempMemo.CopyToClipboard;
  4656.   Memo1.PasteFromClipboard;
  4657.   TempMemo.Free;
  4658. end;
  4659.  
  4660. procedure TCCINetCCForm.SpeedButton5Click(Sender: TObject);
  4661. begin
  4662.   case Tag of
  4663.     5 : AllMarkedArticles1Click( Self );
  4664.   end;
  4665. end;
  4666.  
  4667. procedure TCCINetCCForm.SpeedButton1Click(Sender: TObject);
  4668. begin
  4669.   case Tag of
  4670.     5 : begin
  4671.           if ListBox2.Items.Count = 0 then exit;
  4672.           Listbox2.multiselect := false;
  4673.           If ListBox2.ItemIndex = -1 then ListBox2.ItemIndex := 0;
  4674.           ListBox2.ItemIndex := Listbox2.ItemIndex - 1;
  4675.           if ListBox2.Itemindex < 0 then
  4676.            Listbox2.Itemindex := ListBox2.Items.Count - 1;
  4677.           ListBox2DblClick( Self );
  4678.           ListBox2.Multiselect := true;
  4679.           ListBox2.SetFocus;
  4680.         end;
  4681.   end;
  4682. end;
  4683.  
  4684. procedure TCCINetCCForm.SpeedButton2Click(Sender: TObject);
  4685. begin
  4686.   case Tag of
  4687.     5 : begin
  4688.           if ListBox2.Items.Count = 0 then exit;
  4689.           ListBox2.MultiSelect := false;
  4690.           If ListBox2.ItemIndex = -1 then ListBox2.ItemIndex := 0;
  4691.           ListBox2.ItemIndex := Listbox2.ItemIndex + 1;
  4692.           if ListBox2.Itemindex > ListBox2.Items.Count - 1 then
  4693.            Listbox2.Itemindex := 0;
  4694.           ListBox2DblClick( Self );
  4695.           ListBox2.MultiSelect := true;
  4696.           ListBox2.SetFocus;
  4697.         end;
  4698.   end;
  4699. end;
  4700.  
  4701. procedure TCCINetCCForm.ListBox2Click(Sender: TObject);
  4702. var TheWorkingList : TList;
  4703.     TheNGARecord : PNewsGroupArticleRecord;
  4704.     TheNGRecord : PNewsGroupRecord;
  4705.     TheWorkingName : String;
  4706. begin
  4707.   if ListBox2.Tag = 9 then
  4708.   begin
  4709.     TheNGRecord :=
  4710.      PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4711.     TheWorkingList := TList( TheNGRecord^.GLTag );
  4712.     TheNGARecord := PNewsGroupArticleRecord(
  4713.      TheWorkingList.Items[ ListBox2.ItemIndex ] );
  4714.     TheWorkingName := NewsPath + '\' + TheNGARecord^.NGAArtFileName;
  4715.     TheUUDecodeList.Add( TheWorkingName );
  4716.     exit;
  4717.   end;
  4718.   case Tag of
  4719.     5 : begin
  4720.           If ListBox2.Items.Count = 0 then exit;
  4721.           ComboBox1.Text := ListBox2.Items[ ListBox2.ItemIndex ];
  4722.         end;
  4723.   end;
  4724. end;
  4725.  
  4726. procedure TCCINetCCForm.AbortNewsgroupDownload1Click(Sender: TObject);
  4727. begin
  4728.   GlobalAbortedFlag := true;
  4729. end;
  4730.  
  4731. procedure TCCINetCCForm.Marked1Click(Sender: TObject);
  4732. var Counter_1,
  4733.     Counter_2   : Integer;
  4734.     TheNGRecord : PNewsGroupRecord;
  4735.     TheNGARecord : PNewsGroupArticleRecord;
  4736.     WorkingList : TList;
  4737. begin
  4738.   for Counter_1 := 0 to ListBox1.Items.Count - 1 do
  4739.   begin
  4740.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  4741.     if (( TheNGRecord^.GSubscribed ) and ( ListBox1.Selected[ Counter_1 ] )) then
  4742.     begin
  4743.       WorkingList := TList( TheNGRecord^.GLTag );
  4744.       for Counter_2 := 0 to ListBox2.Items.Count - 1 do
  4745.       begin
  4746.         TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_2 ] );
  4747.         TheNGARecord^.NGARead := true;
  4748.       end;
  4749.       TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4750.       TheNGRecord^.GLowest := TheNGRecord^.GHighestAvailable;
  4751.       TheNGRecord^.GHighest := TheNGRecord^.GLowest;
  4752.       TheNGRecord^.GTotalNew := 0;
  4753.       TheNGRecord^.GTotalArticles := 0;
  4754.     end;
  4755.   end;
  4756.   SetupNewsGroupListboxes;
  4757. end;
  4758.  
  4759. procedure TCCINetCCForm.All1Click(Sender: TObject);
  4760. var Counter_1,
  4761.     Counter_2   : Integer;
  4762.     TheNGRecord : PNewsGroupRecord;
  4763.     TheNGARecord : PNewsGroupArticleRecord;
  4764.     WorkingList : TList;
  4765. begin
  4766.   for Counter_1 := 0 to ListBox1.Items.Count - 1 do
  4767.   begin
  4768.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  4769.     if TheNGRecord^.GSubscribed then
  4770.     begin
  4771.       WorkingList := TList( TheNGRecord^.GLTag );
  4772.       for Counter_2 := 0 to ListBox2.Items.Count - 1 do
  4773.       begin
  4774.         TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_2 ] );
  4775.         TheNGARecord^.NGARead := true;
  4776.       end;
  4777.       TheNGRecord^.GLowest := TheNGRecord^.GHighestAvailable;
  4778.       TheNGRecord^.GHighest := TheNGRecord^.GLowest;
  4779.       TheNGRecord^.GTotalNew := 0;
  4780.       TheNGRecord^.GTotalArticles := 0;
  4781.       TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4782.     end;
  4783.   end;
  4784.   SetupNewsGroupListboxes;
  4785. end;
  4786.  
  4787. procedure TCCINetCCForm.File1Click(Sender: TObject);
  4788. begin
  4789.   OpenDialog1.Filename := '*.uue';
  4790.   OpenDialog1.Filter := 'UUEncode Files|*.uue|All Files *.*';
  4791.   OpenDialog1.Title := 'Select File To Decode';
  4792.   if OpenDialog1.Execute then
  4793.   begin
  4794.     TheUUObject.SetInputFileName( OpenDialog1.FileName );
  4795.     TheUUObject.SetMultifileVector( CMV_SINGLE );
  4796.     TheUUObject.Decode;
  4797.   end;
  4798. end;
  4799.  
  4800. procedure TCCINetCCForm.SelectedArticle1Click(Sender: TObject);
  4801. var TheWorkingList : TList;
  4802.     TheNGARecord : PNewsGroupArticleRecord;
  4803.     TheNGRecord : PNewsGroupRecord;
  4804.     TheWorkingName : String;
  4805. begin
  4806.   TheNGRecord :=
  4807.    PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4808.   TheWorkingList := TList( TheNGRecord^.GLTag );
  4809.   TheNGARecord := PNewsGroupArticleRecord(
  4810.    TheWorkingList.Items[ ListBox2.ItemIndex ] );
  4811.   TheWorkingName := NewsPath + '\' + TheNGARecord^.NGAArtFileName;
  4812.   TheUUObject.SetInputFileName( TheWorkingName );
  4813.   TheUUObject.SetMultifileVector( CMV_SINGLE );
  4814.   TheUUObject.Decode;
  4815. end;
  4816.  
  4817. procedure TCCINetCCForm.SelectMultipleArticles1Click(Sender: TObject);
  4818. begin
  4819.   { Set tag so that listbox knows to keep track of hits}
  4820.   ListBox2.Tag := 9;
  4821.   ListBox2.MultiSelect := false;
  4822.   TheUUDecodeList := TStringList.Create;
  4823. end;
  4824.  
  4825. procedure TCCINetCCForm.DecodeSelections1Click(Sender: TObject);
  4826. begin
  4827.   ListBox2.Tag := 5;
  4828.   ListBox2.MultiSelect := True;
  4829.   if TheUUDecodeList.Count = 0 then exit;
  4830.   TheUUObject.SetMultipleFilesList( TheUUDecodeList );
  4831.   TheUUObject.SetMultifileVector( CMV_MULTI );
  4832.   TheUUObject.Decode;
  4833.   TheUUDecodeList.Free;
  4834. end;
  4835.  
  4836. procedure TCCINetCCForm.SpeedButton4Click(Sender: TObject);
  4837. begin
  4838.   case Tag of
  4839.     5 : begin
  4840.           SelectedArticle1Click( Self );
  4841.         end;
  4842.   end;
  4843. end;
  4844.  
  4845. end.
  4846.  
  4847.